Home > Enterprise >  VBA Loop For Each Workbook and Sheets if avail. loop doesn't activate second sheet
VBA Loop For Each Workbook and Sheets if avail. loop doesn't activate second sheet

Time:09-23

Sub Invoice_Collation()
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String, Fnum As Long
    Dim mybook As Workbook
    Dim CalcMode As Long
    Dim sh As Worksheet
    Dim ErrorYes As Boolean
    Dim wb As Workbook
    Dim lastRowI As Long
    Dim lastRowE As Long, x
    Dim lastRowD As Long
    Dim cell As Range
    Dim ws As Worksheet
    Dim i As Long
    Dim shtCount As Long
    Dim xWs As Worksheet

    MyPath = "D:\Receivables\Sales Invoice copies\Pearson"
    Set wb = Workbooks.Open("D:\Receivables\Sales Invoice copies\Invoice Collation.xlsm")
    Set ws = Workbooks("Invoice Collation").Worksheets("Sheet1")
    'shtCount = Sheets.Count
    
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If
    
    FilesInPath = Dir(MyPath & "*.xlsx*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    Fnum = 0
    Do While FilesInPath <> ""
        Fnum = Fnum   1
        ReDim Preserve MyFiles(1 To Fnum)
        MyFiles(Fnum) = FilesInPath
        FilesInPath = Dir()
    Loop

    With Application
         CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    If Fnum > 0 Then
        For Fnum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
            
            On Error Resume Next
            Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
            On Error GoTo 0
                
            If Not mybook Is Nothing Then
               On Error Resume Next
                With mybook.Worksheets(1)
                    For Each xWs In Application.ActiveWorkbook.Worksheets
    
                     With xWs
                        If .ProtectContents = False Then
                            ActiveSheet.Cells.UnMerge
                            ActiveSheet.Cells.WrapText = False
                            lastRowE = Cells(Rows.Count, "C").End(xlUp).Row
                            ActiveSheet.Cells.Find(What:="Invoice No.").Offset(1).Select
                            Selection.Copy
                            wb.Activate
                            lastRowI = ws.Range("A" & Rows.Count).End(xlUp).Row
                            Range("A" & lastRowI).Offset(1).Select
                            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                            
                            mybook.Worksheets(1).Activate
                            Cells.Find(What:="Title:*", LookAt:=xlPart).EntireRow.Delete 'deletes Title
                            Cells.Find(What:="Item Number", LookAt:=xlPart).EntireColumn.Delete
                            Cells.Find(What:="GL Code", LookAt:=xlPart).EntireColumn.Delete
                            Set cell = Cells.Find(What:="ISBN*", LookAt:=xlWhole)
                            If cell Is Nothing Then
                                mybook.Worksheets(1).Cells.Find(What:="Data Processing ").Offset(1).Select
                                mybook.Worksheets(1).Cells.Find(What:="Data Processing").Offset(1).Select
                            Else
                                mybook.Worksheets(1).Cells.Find(What:="ISBN*", LookAt:=xlPart).Offset(1).Select
                            End If
                            Range(Selection, Selection.End(xlToRight)).Select
                            Range(Selection, Selection.End(xlDown)).Select
                            Selection.Copy
                            lastRowD = ws.Range("B" & Rows.Count).End(xlUp).Row
                            wb.Activate
                            Range("B" & lastRowD).Offset(1).Select
                            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                            
                            Range("A" & lastRowI).Offset(1).Select
                            ActiveCell.Offset(0, 1).Select
                            Selection.End(xlDown).Select
                            ActiveCell.Offset(0, -1).Select
                            Range(Selection, Selection.End(xlUp)).Select
                            Selection.FillDown
                        Else
                            ErrorYes = True
                        End If
                    End With
                   Next
                End With
                    Columns("A:A").Select  'Text to col.
                    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
                    :=Array(1, 1), TrailingMinusNumbers:=True
                    On Error Resume Next
                        Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
                        Cells.Find(What:="Amount in Words", LookAt:=xlPart).EntireRow.Delete
                    On Error GoTo 0

                    
            If Err.Number > 0 Then
                ErrorYes = True
                Err.Clear
                mybook.Close savechanges:=False
            Else
                mybook.Close savechanges:=False
            End If
        On Error GoTo 0
        Else
            'Not possible to open the workbook
            ErrorYes = True
        End If

    Next Fnum
End If
    If ErrorYes = True Then
        MsgBox "There are problems in one or more files, possible problem:" _
             & vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
    End If
    'Restore ScreenUpdating, Calculation and EnableEvents
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
End Sub

CodePudding user response:

Dim x as Variant
For Each x in Workbooks('here is your workbook name').Sheets 'loop sheets array
'something you want where x is a sheet variable if you need sheets name-
Debug.Print x.Name 
Next x 

other variant to loop sheets

For i=1 to Workbooks('here is your workbook name').Sheets.Count' count number of sheets
Debug.Print Workbooks('here is your workbook name').Sheets(i).Name'get the sheet by index
Next i
  • Related