What's the best way to loop code through multiple sheets in the same workbook?

xcelnovice101

Active Member
Joined
Aug 24, 2012
Messages
367
Below is my code for the first tab and as you can tell, I'm cheating by using "Sheets(1)". Rather than having to rename each variable and sheet as "Sheets(2)"....., is there a simple of of having excel loop the exact same code provided below for each sheet in the active workbook? If it is possible, I realize I'll need to adjust part of this code that calls out Sheets(1).

Code:
Sub FS_MTD_REPORT()
Application.ScreenUpdating = False
' Insert Date
    Sheets(1).Select
    Columns("C:C").EntireColumn.AutoFit
    Dim SEAD As Long
    SEAD = Range("C" & Cells.Rows.Count).End(xlUp).Row
    Range(Range("D12"), Range("D" & SEAD)).Formula = "=SEARCH("" TO"",RC[-1])"
    Dim LEND As Long
    LEND = Range("C" & Cells.Rows.Count).End(xlUp).Row
    Range(Range("E12"), Range("E" & LEND)).Formula = "=LEN(RC[-2])"
    Dim RGTD As Long
    RGTD = Range("C" & Cells.Rows.Count).End(xlUp).Row
    Range(Range("F12"), Range("F" & RGTD)).Formula = "=RIGHT(RC[-3],RC[-1]-RC[-2]-2)"
    Dim VLUD As Long
    VLUD = Range("C" & Cells.Rows.Count).End(xlUp).Row
    Range(Range("B12"), Range("B" & VLUD)).Formula = "=VALUE(RC[4])"
    Range(Range("B12"), Range("B" & VLUD)).Copy
    Range("D12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("D12").End(xlDown).ClearContents
    Range("B12").Select
    Range(Selection, Selection.End(xlDown)).ClearContents
    Range("E12:F12").Select
    Range(Selection, Selection.End(xlDown)).ClearContents
    Columns("D:D").EntireColumn.AutoFit
    Columns("D:D").NumberFormat = "m/d/yyyy"
    Columns("F:F").Delete Shift:=xlToLeft
    Range("F12").Select
'Rename Sheets & Save Files
    Dim Port1, Month, Year1, NM As String
    Port1 = Left(Sheets(1).[A2], 4)
    Year1 = Year([D12])
    Month = Format(Sheets(1).[D12], "MMMM")
    Sheets(1).Name = Port1
    NM = Month & " MTD FS Returns.xlsm"
    Sheets(1).Select
    Sheets(1).Copy
    ActiveWorkbook.saveas Filename:="K:\Active Equity\Reconciliations\Monthly\" & Port1 & "\" & Year1 & "\" & NM, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Application.ScreenUpdating = True
End Sub
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,751
See if this gets you started.
Code:
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        With ws
            .Columns("C:C").EntireColumn.AutoFit
            'Continue similarly with the rest of your code here using the dot (.) operator on the ws object
        End With
    Next
 

xcelnovice101

Active Member
Joined
Aug 24, 2012
Messages
367
John_w, I did as you suggested and I think we're close, but the code will not actually go to the next worksheet. It will revert back to the first step and try executing the same code all over again with the current worksheet. Below is my revised code.

Code:
Sub FS_MTD_REPORT()
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    With ws
    .Columns("C:C").EntireColumn.AutoFit
    Dim SEAD As Long
    SEAD = Range("C" & Cells.Rows.Count).End(xlUp).Row
    .Range(Range("D12"), Range("D" & SEAD)).Formula = "=SEARCH("" TO"",RC[-1])"
    Dim LEND As Long
    LEND = Range("C" & Cells.Rows.Count).End(xlUp).Row
    .Range(Range("E12"), Range("E" & LEND)).Formula = "=LEN(RC[-2])"
    Dim RGTD As Long
    RGTD = Range("C" & Cells.Rows.Count).End(xlUp).Row
    .Range(Range("F12"), Range("F" & RGTD)).Formula = "=RIGHT(RC[-3],RC[-1]-RC[-2]-2)"
    Dim VLUD As Long
    VLUD = Range("C" & Cells.Rows.Count).End(xlUp).Row
    .Range(Range("B12"), Range("B" & VLUD)).Formula = "=VALUE(RC[4])"
    .Range(Range("B12"), Range("B" & VLUD)).Copy
    .Range("D12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .Application.CutCopyMode = False
    .Range("D12").End(xlDown).ClearContents
    .Range("B12").Select
    .Range(Selection, Selection.End(xlDown)).ClearContents
    .Range("E12:F12").Select
    .Range(Selection, Selection.End(xlDown)).ClearContents
    .Columns("D:D").EntireColumn.AutoFit
    .Columns("D:D").NumberFormat = "m/d/yyyy"
    .Columns("F:F").Delete Shift:=xlToLeft
    .Range("F12").Select
'Rename Sheets & Save Files
    Dim Port1, Month, Year1, NM As String
    Port1 = Left(Sheets(1).[A2], 4)
    Year1 = Year([D12])
    ActiveSheet.Name = Port1
    Month = Format(Sheets(1).[D12], "MMMM")
    NM = Month & " MTD FS Returns.xlsm"
    ActiveSheet.Select
    ActiveSheet.Copy
    ActiveWorkbook.saveas Filename:="K:\Active Equity\Reconciliations\Monthly\" & Port1 & "\" & Year1 & "\" & NM, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveWorkbook.Close savechanges:=False
    End With
Next ws
Application.ScreenUpdating = True
End Sub
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,711
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Re:
John_w, I did as you suggested and I think we're close, but the code will not actually go to the next worksheet. It will revert back to the first step and try executing the same code all over again with the current worksheet.

The above is not true.

Make up a temporary workbook with a lot of sheets and run (slightly changed) John_w's code in it.
See if all Sheets have 26 in Cell D26.

Code:
Sub test()
Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        With ws
            .Range("D26").Value = 26
        End With
    Next
End Sub
 

cmajka

Board Regular
Joined
Mar 18, 2013
Messages
175

ADVERTISEMENT

I am having the sme issue here. Is there a difference beween sing ThisWorkbook.worsheets and ActiveWorkbook.worksheets?

Thanks
 

xcelnovice101

Active Member
Joined
Aug 24, 2012
Messages
367
Re:
John_w, I did as you suggested and I think we're close, but the code will not actually go to the next worksheet. It will revert back to the first step and try executing the same code all over again with the current worksheet.

The above is not true.

Make up a temporary workbook with a lot of sheets and run (slightly changed) John_w's code in it.
See if all Sheets have 26 in Cell D26.

Code:
Sub test()
Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        With ws
            .Range("D26").Value = 26
        End With
    Next
End Sub

I created a test file with 6 sheets and used your code. Not one sheet has 26 in [D26]
 

xcelnovice101

Active Member
Joined
Aug 24, 2012
Messages
367

ADVERTISEMENT

I am having the sme issue here. Is there a difference beween sing ThisWorkbook.worsheets and ActiveWorkbook.worksheets?

Thanks

ActiveWorkbook did it. Thanks for the inquiry cmajka!
 

xcelnovice101

Active Member
Joined
Aug 24, 2012
Messages
367
I am having a problem with the three highlighted lines of code after the first iteration. Excel is trying to execute these commands on the first sheet. Somehow I need to tell excel to move on to the next ws for these parts of the code.

Code:
Sub FS_MTD_REPORT()
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
    With ws
    .Columns("C:C").EntireColumn.AutoFit
    Dim SEAD As Long
    SEAD = Range("C" & Cells.Rows.Count).End(xlUp).Row
[COLOR=#ff0000]    .Range(Range("D12"), Range("D" & SEAD)).Formula = "=SEARCH("" TO"",RC[-1])"
[/COLOR]    Dim LEND As Long
    LEND = Range("C" & Cells.Rows.Count).End(xlUp).Row
[COLOR=#ff0000]    .Range(Range("E12"), Range("E" & LEND)).Formula = "=LEN(RC[-2])"
[/COLOR]    Dim RGTD As Long
    RGTD = Range("C" & Cells.Rows.Count).End(xlUp).Row
[COLOR=#ff0000]    .Range(Range("F12"), Range("F" & RGTD)).Formula = "=RIGHT(RC[-3],RC[-1]-RC[-2]-2)"
[/COLOR]    Dim VLUD As Long
    VLUD = Range("C" & Cells.Rows.Count).End(xlUp).Row
[COLOR=#ff0000]    .Range(Range("B12"), Range("B" & VLUD)).Formula = "=VALUE(RC[4])"
[/COLOR]    .Range(Range("B12"), Range("B" & VLUD)).Copy
    .Range("D12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .Application.CutCopyMode = False
    .Range("D12").End(xlDown).ClearContents
    .Range("B12").Select
    .Range(Selection, Selection.End(xlDown)).ClearContents
    .Range("E12:F12").Select
    .Range(Selection, Selection.End(xlDown)).ClearContents
    .Columns("D:D").EntireColumn.AutoFit
    .Columns("D:D").NumberFormat = "m/d/yyyy"
    .Columns("F:F").Delete Shift:=xlToLeft
    .Range("F12").Select
'Rename Sheets & Save Files
    Dim Port1, Month, Year1, NM As String
    Port1 = Left(ActiveSheet.[A2], 4)
    Year1 = Year([D12])
    ActiveSheet.Name = Port1
    Month = Format(Sheets(1).[D12], "MMMM")
    NM = Month & " MTD FS Returns.xlsm"
    ActiveSheet.Select
    ActiveSheet.Copy
    ActiveWorkbook.saveas Filename:="K:\Active Equity\Reconciliations\Monthly\" & Port1 & "\" & Year1 & "\" & NM, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveWorkbook.Close savechanges:=False
    End With
Next ws
Application.ScreenUpdating = True
End Sub
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,711
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
According to DataPigTechnologies:
ThisWorkBook object refers to the workbook that the code is contained in. ActiveWorkBook object refers to the workbook that is currently active.

A thing to watch out for.
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,751
I am having a problem with the three highlighted lines of code after the first iteration. Excel is trying to execute these commands on the first sheet. Somehow I need to tell excel to move on to the next ws for these parts of the code.
Qualify each Range reference with the . operator so that it acts on the current ws sheet. For the first line in red this is:
Code:
.Range(.Range("D12"), .Range("D" & SEAD)).Formula = "=SEARCH("" TO"",RC[-1])"
But the line immediately above is also unqualified and further down the code you are operating on the active sheet; is that intentional?
 

Watch MrExcel Video

Forum statistics

Threads
1,129,593
Messages
5,637,294
Members
416,963
Latest member
zazama

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top