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