Excel VBA loop through all workbooks and all worksheets

I want to create Excel VBA to scroll through all .xlsx files and all sheets in these files. However, my code here processed only the first sheet, not all sheets. Can someone let me know if something is wrong with my codes? Many thanks!

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
+4
source share
2 answers

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

For Each ws In wb.Worksheets
    ws.Activate
    LocationReport             
Next ws
+2
source

A massive and OOP-esque way to handle this is 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

, , Range.Select, Selection.Method. , , , .

.

+4

Source: https://habr.com/ru/post/1629643/


All Articles