Solved: Set worksheet Target

[BENSON]

The code below transfers data from one workbook book to another.The source workbook has seven sheets "TUES ,WED,THURS,FRI,SAT,SUN,MON"
The destination workbook Called "history File at Present has only one sheet called "Sheet 1" I would like to change the history file so it also has seven sheets i named the same as the soruce workbook ie: TUES,WED etc Where I need the help is to alter the code below so if the macro is run when the active sheet in the source file is say WED it will paste the data for that day in the corresponding sheet in the history filei e WED

Thanks for any help

[VBA]
Private Sub Workbook_BeforeClose(Cancel As Boolean)

a = MsgBox("ARE YOU READY TO UPDATE THE HISTORY FILE?", _
vbYesNo)

If a = vbYes Then
Cancel = True
Dim WsTgt As Excel.Worksheet
Dim rngCopy As Excel.Range
Application.ScreenUpdating = False
Set WsTgt = Workbooks("Gardens History.xls").Sheets(1)
With WsTgt.Range("A" & NextEmptyRow(WsTgt))
.Value = Date
.NumberFormat = "ddd dd mmm yy"
' Add C285 and C286
ActiveSheet.Range("C284").Copy
.Offset(, 1).PasteSpecial xlPasteValues
ActiveSheet.Range("C286").Copy
.Offset(, 2).PasteSpecial xlPasteValues
ActiveSheet.Range("C288").Copy
.Offset(, 3).PasteSpecial xlPasteValues

Set rngCopy = ActiveSheet.Range("G260:AZ260")
rngCopy.Copy
.Offset(, 4).PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End With
Else
Rem Cancel = True:Rem If you don't want No=Close
End If
End Sub


Function NextEmptyRow(Wks As Worksheet) As Long
Dim Rng As Range
Set Rng = Wks.Range("A" & Wks.Rows.Count).End(xlUp)
If Rng <> "" Then Set Rng = Rng.Offset(1)
NextEmptyRow = Rng.Row
End Function

Private Sub Workbook_Open()
End Sub
[/VBA]

[herzberg]

All that is needed is to compare the the worksheets' names using loops:

[vba]Public Sub UpdateMe()

'Sourcewb refers to the workbook where the data is stored;
'Targetwb refers to the workbook where data is going to be pasted into
Set Sourcewb = Workbooks("Book1")
Set Targetwb = Workbooks("Book2")

For Each SourceSheet In Sourcewb.Sheets
For Each TargetSheet In Targetwb.Sheets
If SourceSheet.Name = TargetSheet.Name Then

'Rest of the code follows

End If
Next TargetSheet
Next SourceSheet

End Sub[/vba]
Of course, I think you may need to amend your original code so as to fit it into the loop. The code is kinda lengthy and I've saved it in the attached file. Check it out for the actual changes I did.

[BENSON]

Adjusted code as per your suggestion but get a problem on the highligted piece of code below

[VBA]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
a = MsgBox("ARE YOU READY TO UPDATE THE HISTORY FILE?", _
vbYesNo)
If a = vbYes Then
Cancel = True
Dim WsTgt As Excel.Worksheet
Dim rngCopy As Excel.Range
Application.ScreenUpdating = False
Set Sourcewb = Workbooks("Book1.xls")
Set Targetwb = Workbooks("Book2.xls")

For Each SourceSheet In Sourcewb.Sheets
For Each TargetSheet In Targetwb.Sheets
If SourceSheet.Name = TargetSheet.Name Then

With WsTgt.Range("A" & NextEmptyRow(WsTgt))
.Value = Date
.NumberFormat = "ddd dd mmm yy"
' Add C285 and C286
ActiveSheet.Range("C284").Copy
.Offset(, 1).PasteSpecial xlPasteValues
ActiveSheet.Range("C286").Copy
.Offset(, 2).PasteSpecial xlPasteValues
ActiveSheet.Range("C288").Copy
.Offset(, 3).PasteSpecial xlPasteValues

Set rngCopy = ActiveSheet.Range("G260:AZ260")
rngCopy.Copy
.Offset(, 4).PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End With
End If
Next TargetSheet
Next SourceSheet
End If
End Sub


Function NextEmptyRow(Wks As Worksheet) As Long
Dim Rng As Range
Set Rng = Wks.Range("A" & Wks.Rows.Count).End(xlUp)
If Rng <> "" Then Set Rng = Rng.Offset(1)
NextEmptyRow = Rng.Row
End Function

Private Sub Workbook_Open()
End Sub
[/VBA]

[herzberg]

Change this line [vba]With WsTgt.Range("A" & NextEmptyRow(WsTgt)) [/vba] to this [vba]With TargetSheet.Range("A" & NextEmptyRow(TargetSheet))[/vba]
You will need to change all references of "Activesheet" to "SourceSheet" instead.

[BENSON]

Thanks for code , but am getting messge "Compile error ByRef arugument mismatch " where highlighted on code below

[VBA]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
a = MsgBox("ARE YOU READY TO UPDATE THE HISTORY FILE?", _
vbYesNo)
If a = vbYes Then
Cancel = True
Dim WsTgt As Excel.Worksheet
Dim rngCopy As Excel.Range
Application.ScreenUpdating = False
Set Sourcewb = Workbooks("Book1.xls")
Set Targetwb = Workbooks("Book2.xls")

For Each SourceSheet In Sourcewb.Sheets
For Each TargetSheet In Targetwb.Sheets
If SourceSheet.Name = TargetSheet.Name Then

With TargetSheet.Range("A" & NextEmptyRow(TargetSheet))
.Value = Date
.NumberFormat = "ddd dd mmm yy"
' Add C285 and C286
SourceSheet.Range("C284").Copy
.Offset(, 1).PasteSpecial xlPasteValues
SourceSheet.Range("C286").Copy
.Offset(, 2).PasteSpecial xlPasteValues
SourceSheet.Range("C288").Copy
.Offset(, 3).PasteSpecial xlPasteValues

Set rngCopy = SourceSheet.Range("G260:AZ260")
rngCopy.Copy
.Offset(, 4).PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End With
End If
Next TargetSheet
Next SourceSheet
End If
End Sub
[/VBA]

[Bob Phillips]

Not tested

[vba]

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If MsgBox("ARE YOU READY TO UPDATE THE HISTORY FILE?", vbYesNo) = vbYes Then
Cancel = True
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim SourceWb As Workbook
Dim TargetWb As Workbook
Dim rngCopy As Range
Application.ScreenUpdating = False
Set SourceWb = Workbooks("Book1.xls")
Set TargetWb = Workbooks("Book2.xls")

For Each SourceSheet In SourceWb.Sheets
For Each TargetSheet In TargetWb.Worksheets
If SourceSheet.Name = TargetSheet.Name Then

With TargetSheet.Range("A" & NextEmptyRow(TargetSheet))
.Value = Date
.NumberFormat = "ddd dd mmm yy"
' Add C285 and C286
SourceSheet.Range("C284").Copy
.Offset(, 1).PasteSpecial xlPasteValues
SourceSheet.Range("C286").Copy
.Offset(, 2).PasteSpecial xlPasteValues
SourceSheet.Range("C288").Copy
.Offset(, 3).PasteSpecial xlPasteValues

Set rngCopy = SourceSheet.Range("G260:AZ260")
rngCopy.Copy
.Offset(, 4).PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End With
End If
Next TargetSheet
Next SourceSheet
End If
End Sub
[/vba]

[BENSON]

The marco runs but pastes the data into all seven sheets rather then just the specfic sheet required

Thanks for the help so far

[BENSON]

Sorry relooked at the pasted information .The macro does pastes the specific days data into the required destination sheet .ie as today is friday the source sheet FRI will paste to destination sheet FRI.However what is also happing is that it pastes the date the macro is run to all the other sheets, no data just the date .This results in the other sheets all having a date placed in them but no adjacent data just "0"s

[Aussiebear]

Since there was some code provided in another thread just recently which locked all columns other than that with a current date header, is it possible to make a sheet active based on a date?

Since today if Friday (here in Australia) then only the Friday sheet would be active and you could past to the active sheet.

Its just an idea, but if you want to roll round of the floor laughing your proverbial off then feel free.....

[BENSON]

I could try it do you have the code ?

Thanks

[Aussiebear]

Sorry I don't. Its just a thought at this stage. Maybe some of the much wiser heads here can tell if I'm just barking up the wrong tree.

[BENSON]

Is there away to adjust the code to get it to work as required ,I know I posted this before but thought maybe some one could relook at my problem.The marco runs but pastes the data into all seven sheets rather then just the specfic sheet required

Thanks for the help so far

[herzberg]

I think I'm seeing the issue here. The code that I wrote previously compares each and every worksheet from both the original workbook and the destination workbook, including the ones that you may not want to be copied and pasted.

What I can suggest is to rename the source worksheets, as well as the destination worksheets, to have similar names. For instance, with a prefix "Data". Then the code can be amended to look like this:
[vba]
For Each SourceSheet In SourceWb.Sheets
If SourceSheet.Name Like "Data*" Then 'Additional check here
For Each TargetSheet In TargetWb.Worksheets
If SourceSheet.Name = TargetSheet.Name Then
'Rest of the code goes here[/vba] So what is does is to first check for source worksheets that have this prefix, then it carries on to look for a corresponding match in the destination workbook and execute the rest of the code.

[BENSON]

Thanks for the idea ,I changed code to as seen below and prefixed each worksheet with "Data" ie: "Data TUES,Data WED etc " ( I hope this is want you meant. I get the error message (Compile Error NEXT without FOR ) where Ihave highlited code below
Thanks for the help on this
[VBA]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If MsgBox("ARE YOU READY TO UPDATE THE HISTORY FILE?", vbYesNo) = vbYes Then
Cancel = True
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim ActiveWb As Workbook
Dim TargetWb As Workbook
Dim rngCopy As Range
Application.ScreenUpdating = False
Set ActiveWb = Workbooks("Book1.xls")
Set TargetWb = Workbooks("Book2.xls")

For Each SourceSheet In SourceWb.Sheets
If SourceSheet.Name Like "Data*" Then 'Additional check here
For Each TargetSheet In TargetWb.Worksheets
If SourceSheet.Name = TargetSheet.Name Then

With TargetSheet.Range("A" & NextEmptyRow(TargetSheet))
.Value = Date
.NumberFormat = "ddd dd mmm yy"
' Add C285 and C286
SourceSheet.Range("C284").Copy
.Offset(, 1).PasteSpecial xlPasteValues
SourceSheet.Range("C286").Copy
.Offset(, 2).PasteSpecial xlPasteValues
SourceSheet.Range("C288").Copy
.Offset(, 3).PasteSpecial xlPasteValues

Set rngCopy = SourceSheet.Range("G260:AZ260")
rngCopy.Copy
.Offset(, 4).PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End With
End If
Next TargetSheet

Next SourceSheet
End If
End Sub
[/VBA]

[BENSON]

Thanks for the idea ,I changed code to as seen below and prefixed each worksheet with "Data" ie: "Data TUES,Data WED etc " ( I hope this is want you meant. I get the error message (Compile Error NEXT without FOR ) where Ihave highlited code below
Thanks for the help on this
[VBA]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If MsgBox("ARE YOU READY TO UPDATE THE HISTORY FILE?", vbYesNo) = vbYes Then
Cancel = True
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim ActiveWb As Workbook
Dim TargetWb As Workbook
Dim rngCopy As Range
Application.ScreenUpdating = False
Set ActiveWb = Workbooks("Book1.xls")
Set TargetWb = Workbooks("Book2.xls")

For Each SourceSheet In SourceWb.Sheets
If SourceSheet.Name Like "Data*" Then 'Additional check here
For Each TargetSheet In TargetWb.Worksheets
If SourceSheet.Name = TargetSheet.Name Then

With TargetSheet.Range("A" & NextEmptyRow(TargetSheet))
.Value = Date
.NumberFormat = "ddd dd mmm yy"
' Add C285 and C286
SourceSheet.Range("C284").Copy
.Offset(, 1).PasteSpecial xlPasteValues
SourceSheet.Range("C286").Copy
.Offset(, 2).PasteSpecial xlPasteValues
SourceSheet.Range("C288").Copy
.Offset(, 3).PasteSpecial xlPasteValues

Set rngCopy = SourceSheet.Range("G260:AZ260")
rngCopy.Copy
.Offset(, 4).PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End With
End If
Next TargetSheet

Next SourceSheet
End If
End Sub
[/VBA]

[Aussiebear]

Not tested, but I noticed the possibility that the "Next SourceSheet" and the "End If" may be the wrong way around?

I mean if you pair them off as you close out the sequence...

[VBA]Private Sub Workbook_BeforeClose(Cancel As Boolean)
If MsgBox("ARE YOU READY TO UPDATE THE HISTORY FILE?", vbYesNo) = vbYes Then
Cancel = True
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim ActiveWb As Workbook
Dim TargetWb As Workbook
Dim rngCopy As Range
Application.ScreenUpdating = False
Set ActiveWb = Workbooks("Book1.xls")
Set TargetWb = Workbooks("Book2.xls")

For Each SourceSheet In SourceWb.Sheets
If SourceSheet.Name Like "Data*" Then 'Additional check here
For Each TargetSheet In TargetWb.Worksheets
If SourceSheet.Name = TargetSheet.Name Then

With TargetSheet.Range("A" & NextEmptyRow(TargetSheet))
.Value = Date
.NumberFormat = "ddd dd mmm yy"
' Add C285 and C286
SourceSheet.Range("C284").Copy
.Offset(, 1).PasteSpecial xlPasteValues
SourceSheet.Range("C286").Copy
.Offset(, 2).PasteSpecial xlPasteValues
SourceSheet.Range("C288").Copy
.Offset(, 3).PasteSpecial xlPasteValues

Set rngCopy = SourceSheet.Range("G260:AZ260")
rngCopy.Copy
.Offset(, 4).PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End With
End If
Next TargetSheet
End If
Next SourceSheet

End Sub [/VBA]

[BENSON]

Thanks for trying aussiebear but does not seem to help

[Aussiebear]

Hmmm... missed the End IF for the initial If, so does this work?

[VBA]Private Sub Workbook_BeforeClose(Cancel As Boolean)
If MsgBox("ARE YOU READY TO UPDATE THE HISTORY FILE?", vbYesNo) = vbYes Then
Cancel = True
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim ActiveWb As Workbook
Dim TargetWb As Workbook
Dim rngCopy As Range
Application.ScreenUpdating = False
Set ActiveWb = Workbooks("Book1.xls")
Set TargetWb = Workbooks("Book2.xls")

For Each SourceSheet In SourceWb.Sheets
If SourceSheet.Name Like "Data*" Then 'Additional check here
For Each TargetSheet In TargetWb.Worksheets
If SourceSheet.Name = TargetSheet.Name Then

With TargetSheet.Range("A" & NextEmptyRow(TargetSheet))
.Value = Date
.NumberFormat = "ddd dd mmm yy"
' Add C285 and C286
SourceSheet.Range("C284").Copy
.Offset(, 1).PasteSpecial xlPasteValues
SourceSheet.Range("C286").Copy
.Offset(, 2).PasteSpecial xlPasteValues
SourceSheet.Range("C288").Copy
.Offset(, 3).PasteSpecial xlPasteValues

Set rngCopy = SourceSheet.Range("G260:AZ260")
rngCopy.Copy
.Offset(, 4).PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End With
End If
Next TargetSheet
End If
Next SourceSheet
End IF

End Sub[/VBA]

[BENSON]

Hi Aussie bear I think I must give this one up as a bad job the code (Pasted Below )seems to read correct but nothing happens thanks for your time anyway
[VBA]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If MsgBox("ARE YOU READY TO UPDATE THE HISTORY FILE?", vbYesNo) = vbYes Then
Cancel = True
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim SourceWb As Workbook
Dim TargetWb As Workbook
Dim rngCopy As Range
Application.ScreenUpdating = False
Set SourceWb = Workbooks("Book1.xls")
Set TargetWb = Workbooks("Book2.xls")

For Each SourceSheet In SourceWb.Sheets
If SourceSheet.Name Like "Data*" Then 'Additional check here
For Each TargetSheet In TargetWb.Worksheets
If SourceSheet.Name = TargetSheet.Name Then

With TargetSheet.Range("A" & NextEmptyRow(TargetSheet))
.Value = Date
.NumberFormat = "ddd dd mmm yy"
' Add C285 and C286
SourceSheet.Range("C284").Copy
.Offset(, 1).PasteSpecial xlPasteValues
SourceSheet.Range("C286").Copy
.Offset(, 2).PasteSpecial xlPasteValues
SourceSheet.Range("C288").Copy
.Offset(, 3).PasteSpecial xlPasteValues

Set rngCopy = SourceSheet.Range("G260:AZ260")
rngCopy.Copy
.Offset(, 4).PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End With
End If
Next TargetSheet
End If
Next SourceSheet
End If

End Sub
[/VBA]

[mikerickson]

This worked for me
[vba]If MsgBox("ARE YOU READY TO UPDATE THE HISTORY FILE?", vbYesNo) = vbYes Then
Cancel = True
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim SourceWb As Workbook
Dim TargetWb As Workbook
Dim rngCopy As Range

Application.ScreenUpdating = False
Set SourceWb = Workbooks("Book1.xls")
Set TargetWb = Workbooks("Book2.xls")

For Each SourceSheet In SourceWb.Sheets
If SourceSheet.Name Like "Data*" Then 'Additional check here

For Each TargetSheet In TargetWb.Worksheets
If SourceSheet.Name = TargetSheet.Name Then

With TargetSheet.Range("A" & NextEmptyRow(TargetSheet))
.Value = Date
.NumberFormat = "ddd dd mmm yy"
' Add C285 and C286
.Offset(, 1).Value = SourceSheet.Range("C284").Value
.Offset(, 2).Value = SourceSheet.Range("C286").Value
.Offset(, 3).Value = SourceSheet.Range("C288").Value
.Offset(, 4).Resize(1, 46).Value = SourceSheet.Range("G260:AZ260").Value
End With

End If
Next TargetSheet

End If
Next SourceSheet

Application.ScreenUpdating = True
End If
End Sub

Function NextEmptyRow(oneSheet As Worksheet) As Long
With oneSheet
NextEmptyRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End With
End Function
[/vba]