G
Grey Old Man
My code below works OK:
Private Sub Worksheet_Activate()
On Error GoTo Error:
Application.ScreenUpdating = False
Dim SourceSheetA As String
Dim SourceSheetB As String
Dim TargetSheet As String
Dim StartCopy As String
Dim EndColumn As String
Dim CountA As Long
Dim CountB As Long
Dim CountC As Long
'--------------------------------------------------
SourceSheetA = "My data"
SourceSheetB = "New Data"
TargetSheet = "Combined"
StartCopy = "A2"
EndColumn = "J"
'--------------------------------------------------
CountA = Sheets(SourceSheetA).Cells(Cells.Rows.Count, "A").End(xlUp).Row
CountB = Sheets(SourceSheetB).Cells(Cells.Rows.Count, "A").End(xlUp).Row
CountC = CountA + CountB
'--------------------------------------------------
Worksheets(SourceSheetA).Range(StartCopy & ":" & EndColumn & CountA).Copy
Worksheets(TargetSheet).Range(StartCopy & ":" & EndColumn &
CountA).PasteSpecial xlPasteValues
Application.CutCopyMode = False
'--------------------------------------------------
Worksheets(SourceSheetB).Range(StartCopy & ":" & EndColumn & CountB).Copy
Worksheets(TargetSheet).Range("A" & CountA + 1 & ":" & EndColumn &
CountC).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Range("A1").Select
'--------------------------------------------------
Exit Sub
Error:
MsgBox "Error"
End Sub
I need to expand this to include dozens more worksheets, perhaps by listing
them all in a string (? array). This list would need to be changed on a
regular basis.
Can anyone help in writing a loop to copy all of the data in all of the
worksheets nominated in the list?
I could always repeat the code for each worksheet but this seems a bit
cumbersome and high maintenance.
Thanks in anticipation.
Private Sub Worksheet_Activate()
On Error GoTo Error:
Application.ScreenUpdating = False
Dim SourceSheetA As String
Dim SourceSheetB As String
Dim TargetSheet As String
Dim StartCopy As String
Dim EndColumn As String
Dim CountA As Long
Dim CountB As Long
Dim CountC As Long
'--------------------------------------------------
SourceSheetA = "My data"
SourceSheetB = "New Data"
TargetSheet = "Combined"
StartCopy = "A2"
EndColumn = "J"
'--------------------------------------------------
CountA = Sheets(SourceSheetA).Cells(Cells.Rows.Count, "A").End(xlUp).Row
CountB = Sheets(SourceSheetB).Cells(Cells.Rows.Count, "A").End(xlUp).Row
CountC = CountA + CountB
'--------------------------------------------------
Worksheets(SourceSheetA).Range(StartCopy & ":" & EndColumn & CountA).Copy
Worksheets(TargetSheet).Range(StartCopy & ":" & EndColumn &
CountA).PasteSpecial xlPasteValues
Application.CutCopyMode = False
'--------------------------------------------------
Worksheets(SourceSheetB).Range(StartCopy & ":" & EndColumn & CountB).Copy
Worksheets(TargetSheet).Range("A" & CountA + 1 & ":" & EndColumn &
CountC).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Range("A1").Select
'--------------------------------------------------
Exit Sub
Error:
MsgBox "Error"
End Sub
I need to expand this to include dozens more worksheets, perhaps by listing
them all in a string (? array). This list would need to be changed on a
regular basis.
Can anyone help in writing a loop to copy all of the data in all of the
worksheets nominated in the list?
I could always repeat the code for each worksheet but this seems a bit
cumbersome and high maintenance.
Thanks in anticipation.