Hi All,
I have a number of sheets in the workbook, all labelled differently, and I only want to copy sheets from sheet codenames sheet10 onwards.
I am using the following code and while before changes I could get it to copy all the sheets, now, as it stands it copies none of them.
What am I doing wrong?
Thanks heaps with the help.
Code
Sub CopyAll()
Dim ws As Worksheet
On Error Resume Next
If Err Then
On Error GoTo 0
Else
Sheets("Sheets Combined").Select
Range("A2:AC2000").Select
Selection.AutoFilter Field:=1, Criteria1:="<>"
Sheets("Sheets Combined").ShowAllData
Sheets("Sheets Combined").Select
Range("A3:AC2000").Select
Range("A3:AC2000").ClearContents
Range("A3:AC2000").ClearFormats
Range("A3").Select
End If
'Sort and copy data
For Each ws In ActiveWorkbook.Worksheets
If ws.CodeName = ("Sheet1") Or ("Sheet2") Or ("Sheet3") Or ("Sheet4") Or ("Sheet5") Or ("Sheet6") Or ("Sheet7") Or ("Sheet8") Or ("Sheet9") Then
Else
ws.Activate
Range("A3:AC2000").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A3").Select
ActiveSheet.Range("A3:AC2000").Copy
Sheets("Sheets Combined").Select
Range("A3").Select
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
ActiveSheet.Cells(emptyRow, 1).PasteSpecial
Range("A3").Select
Sheets("Sheets Combined").Select
Range("A2").Activate
Range("A2:AC2000").Select
Selection.AutoFilter Field:=1, Criteria1:="<>"
Worksheets("Sheets Combined").ShowAllData
ActiveSheet.Range("A3").Select
ws.Activate
Range("A2:AC2000").Select
Selection.AutoFilter Field:=1, Criteria1:="<>"
ws.ShowAllData
Range("A3").Select
Sheets("Sheets Combined").Select
Range("A3").Select
End If
Next ws
' Display confirmation message
Sheets("Review Template").Select
ActiveWindow.Panes(2).ScrollRow = 14
With ActiveSheet.PageSetup
.PrintTitleRows = "1:14"
.PrintTitleColumns = ""
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.Order = xlDownThenOver
.BlackAndWhite = True
.Zoom = False
.FitToPagesTall = 200
.FitToPagesWide = 1
End With
ActiveSheet.Range("A1").Select
MsgBox "Task Complete", vbInformation, "Task Completed"
End Sub