CODEWITHSUNDEEP
vbaexcel
user5953931
user5953931

Reputation: 43

Excel VBA loop through all workbooks and all worksheets

I want to create an Excel VBA to loop through all .xlsx files and all sheets in those files. However, my code here would only process the first sheet instead of all sheets. Could someone let me know if there is anything wrong with my codes? Thanks a lot!

Sub Rollup()

Dim wb As Workbook, MyPath, MyTemplate, MyName
Dim ws As Worksheet

MyPath = "I:\Reports\Rollup Reports\"
MyTemplate = "*.xlsx"  
MyName = Dir(MyPath & MyTemplate)    
Do While MyName <> ""
    Set wb = Workbooks.Open(MyPath & MyName)
        For Each ws In wb.Worksheets
            LocationReport             
        Next ws
    wb.Close True    
    MyName = Dir()                 
Loop
End Sub

Sub LocationReport()

Application.ScreenUpdating = False

Range("N4").Select
ActiveCell.FormulaR1C1 = "1"
Range("N4").Select
Selection.Copy
Range("B2:J7,B10:J20,B23:J28").Select
Range("B23").Activate
Selection.PasteSpecial Paste:=xlAll, Operation:=xlMultiply, SkipBlanks:= _
    False, Transpose:=False
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Application.ScreenUpdating = True

End Sub

Upvotes: 4

Views: 488

Answers (2)

Hambone
Hambone

Reputation: 16377

A scalable and OOP-esque way to handle this would be to pass the worksheet as a parameter:

Sub Rollup()
    Dim wb As Workbook, MyPath, MyTemplate, MyName
    Dim ws As Worksheet

    MyPath = "I:\Reports\Rollup Reports\"
    MyTemplate = "*.xlsx"
    MyName = Dir(MyPath & MyTemplate)
    Do While MyName <> ""
        Set wb = Workbooks.Open(MyPath & MyName)
            For Each ws In wb.Worksheets
                LocationReport (ws)
            Next ws
        wb.Close True
        MyName = Dir()
    Loop
End Sub

Sub LocationReport(ByRef ws As Worksheet)
    Application.ScreenUpdating = False

    With ws
      .Range("N4").FormulaR1C1 = "1"
      .Range("N4").Copy
      .Range("B2:J7,B10:J20,B23:J28").Select
      .Range("B23").Activate
      .Selection.PasteSpecial Paste:=xlAll, Operation:=xlMultiply, SkipBlanks:= _
            False, Transpose:=False

      With .Rows("1:1")
        Application.CutCopyMode = False
        .Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        .Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        .Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      End With
    End With

    Application.ScreenUpdating = True
End Sub

Also, slightly off-topic, but I try to avoid using the Range.Select and then Selection.Method methodology. It's generally better, when possible, to just apply your actions to the range.

I made some of the changes above as an example.

Upvotes: 4

SincereApathy
SincereApathy

Reputation: 675

Try adding ws.Activate inside your for each ws loop:

For Each ws In wb.Worksheets
    ws.Activate
    LocationReport             
Next ws

Upvotes: 2

Related Questions