Hello,
I am trying to loop the following code for a total of 15 worksheets without copying and pasting that same code 14 more times for each worksheet. Right now it is only executing the code on the "CAN" tab. Is there a way to make it loop where indicated below?
The 15 worksheets are:
CAN
USA
ASG
Gallia
IGEM
LAT
NOR
SPAI
UKI
ANZ
ASE
China
IND
JPN
Skorea
Is it better to use Sheet(1) rather than the names of the tabs?
Code
Public Sub Supervised_Data_Build()
subUnprotect
Application.Calculation = xlCalculationManual
ActiveSheet.DisplayPageBreaks = False
Application.ScreenUpdating = False
'Unfilter
Sheets("Sup_Data").Select
If ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
'Clear Existing Entries
Sheets("Sup_Data").Select
Range("A2:Q1048576").Select
Selection.Clear
Sheets("Sup_Data(2)").Select
Range("A2:Q1048576").Select
Selection.Clear
'LOOP THROUGH WORKSHEETS WOULD START HERE
'Copy and paste Supervised data into Sup_Data Tab
With Worksheets("CAN")
.Range(.Cells(intRow_01, intCol_01), .Cells((intRow_01 + intGroup), intCol_07)).Copy
Worksheets("Sup_Data").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
.Range(.Cells(intRow_01, intCol_09), .Cells((intRow_01 + intGroup), intCol_09)).Copy
Worksheets("Sup_Data").Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
.Range(.Cells(intRow_01, intCol_12), .Cells((intRow_01 + intGroup), intCol_12)).Copy
Worksheets("Sup_Data").Range("L" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
.Range(.Cells(intRow_01, intCol_15), .Cells((intRow_01 + intGroup), intCol_15)).Copy
Worksheets("Sup_Data").Range("M" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
.Range(.Cells(intRow_01, intCol_23), .Cells((intRow_01 + intGroup), intCol_23)).Copy
Worksheets("Sup_Data").Range("N" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
.Range(.Cells(intRow_01, intCol_26), .Cells((intRow_01 + intGroup), intCol_26)).Copy
Worksheets("Sup_Data").Range("O" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
.Range(.Cells(intRow_01, intCol_29), .Cells((intRow_01 + intGroup), intCol_29)).Copy
Worksheets("Sup_Data").Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
.Range(.Cells(intRow_01, intCol_32), .Cells((intRow_01 + intGroup), intCol_32)).Copy
Worksheets("Sup_Data").Range("Q" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
End With
'Inserts CSG Name
'CMT
Worksheets("CAN").Range("$F$5").Copy
Worksheets("Sup_Data").Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(CMTRow).PasteSpecial (xlPasteValues)
'FS
Worksheets("CAN").Range("$F$610").Copy
Worksheets("Sup_Data").Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(CSGRows).PasteSpecial (xlPasteValues)
'HPS
Worksheets("CAN").Range("$F$1215").Copy
Worksheets("Sup_Data").Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(CSGRows).PasteSpecial (xlPasteValues)
'PRD
Worksheets("CAN").Range("$F$1820").Copy
Worksheets("Sup_Data").Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(CSGRows).PasteSpecial (xlPasteValues)
'RES
Worksheets("CAN").Range("$F$3030").Copy
Worksheets("Sup_Data").Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(CSGRows).PasteSpecial (xlPasteValues)
'Other
Worksheets("CAN").Range("$F$3030").Copy
Worksheets("Sup_Data").Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(CSGRows).PasteSpecial (xlPasteValues)
'SG_CD
Worksheets("CAN").Range("$B$1").Copy
Worksheets("Sup_Data").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(intGroup).PasteSpecial (xlPasteValues)
'GU
Worksheets("CAN").Range("$B$2").Copy
Worksheets("Sup_Data").Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(intGroup).PasteSpecial (xlPasteValues)
'WANT to have it loop here to next worksheet
'Filter for wanted data
Worksheets("Sup_Data").Range("$A$1:$Q$1048576").AutoFilter Field:=9, Criteria1:=Array( _
"Contract Hrs", "Supervised FTE", "Total Labor Costs", "Unloaded Chg Payroll"), _
Operator:=xlFilterValues
Worksheets("Sup_Data").Range("$A$1:$Q$8964").AutoFilter Field:=5, Criteria1:="<>"
Dim LastRow As Integer
LastRow = [A1048576].End(xlUp).Row
'Copy Visable Values
Sheets("Sup_Data").Select
Range("A2:Q1048576").Select
Selection.SpecialCells(xlCellTypeVisible).Copy
'Paste Values to Sup_Data(2) worksheet
Worksheets("Sup_Data(2)").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.ScreenUpdating = True
'Save Sup_data(2)to new workbook
'Sheets("Sup_Data(2)").Select
'Sheets("Sup_Data(2)").Copy
'Application.DisplayAlerts = False
'ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Supervised Stacked Data" & ".xlsx", _
'FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'Application.DisplayAlerts = True
'ActiveWorkbook.Close Saved = False
End SubThanks as always for your help!
