Put multiple fields from various excel invoices into 1 spreadsheet

RogPos 

Please find the attached with a code called "CombineAllInvoices" on m_CombineAllInvoices Module.

The file has a hidden sheet called Template in it with the headers only.

You will also find a button called "Combine All Invoices" on Main Sheet and you may click this button to run the code.

Here is the code....

Sub CombineAllInvoices()
Dim xlApp                   As Application
Dim wbMaster                As Workbook
Dim wbInvoice               As Workbook
Dim wsMaster                As Worksheet
Dim wsInvoice               As Worksheet
Dim strSourceFolderPath     As String
Dim strNewFolderPath        As String
Dim strNewFileName          As String
Dim strMoveFolderName       As String
Dim fso                     As Object
Dim SourceFolder            As Object
Dim Invoice                 As Object
Dim rngQty                  As Range
Dim rngTotal                As Range
Dim lr                      As Long
Dim dlr                     As Long
Dim i                       As Long
Dim Dicsount                As Double

Application.ScreenUpdating = False
Application.DisplayAlerts = False

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Invoice Folder!"
    .AllowMultiSelect = False
    If .Show <> -1 Then
        MsgBox "You didn't select any Invoice Folder.", vbExclamation
        Exit Sub
    Else
        strSourceFolderPath = .SelectedItems(1)
    End If
End With

Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(strSourceFolderPath)

'Invoice Files processed by the code will be transferred to the following sub-folder in the chosen source folder
strMoveFolderName = "Invoiced Moved"
strMoveFolderName = strMoveFolderName & " " & Format(Now, "dd-mmm-yy hhmmss")
strMoveFolderName = strSourceFolderPath & "\" & strMoveFolderName

'Creating folder to move already processed invoice files
fso.CreateFolder (strMoveFolderName)

With ThisWorkbook.Worksheets("Template")
    .Visible = xlSheetVisible
    .Copy
    .Visible = xlSheetVeryHidden
End With

Set wbMaster = ActiveWorkbook
Set wsMaster = wbMaster.Worksheets(1)
wsMaster.Name = "All Invoices"

On Error GoTo Skip
Set xlApp = New Application

For Each Invoice In SourceFolder.Files
    If LCase(fso.GetExtensionName(Invoice)) = "xls" Or LCase(fso.GetExtensionName(Invoice)) = "xlsx" Then
        If Left(Invoice.Name, 1) = "#" Then
            Set wbInvoice = xlApp.Workbooks.Open(Invoice)
            Set wsInvoice = wbInvoice.Worksheets("Invoice")
            
            Set rngQty = wsInvoice.Range("D:D").Find(what:="Qty", lookat:=xlWhole)
            
            If Not rngQty Is Nothing Then
                Set rngTotal = wsInvoice.Range("K:K").Find(what:="TOTAL*", lookat:=xlWhole, MatchCase:=False)
                lr = rngTotal.Row - 5
                For i = rngQty.Row + 1 To lr
                    If wsInvoice.Cells(i, 4) <> "" And wsInvoice.Cells(i, 5) <> "Discount" Then
                        dlr = wsMaster.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                        
                        'Invoice details
                        wsMaster.Range("A" & dlr).Value = wsInvoice.Range("data5").Value
                        wsMaster.Range("B" & dlr).Value = wsInvoice.Range("data6").Value
                        wsMaster.Range("C" & dlr).Value = wsInvoice.Range("data7").Value
                        wsMaster.Range("D" & dlr).Value = wsInvoice.Range("data8").Value
                        wsMaster.Range("E" & dlr).Value = wsInvoice.Range("data9").Value
                        wsMaster.Range("F" & dlr).Value = wsInvoice.Range("data10").Value
                        wsMaster.Range("G" & dlr).Value = wsInvoice.Range("data1").Value
                        wsMaster.Range("H" & dlr).Value = wsInvoice.Range("NO").Value
                        wsMaster.Range("I" & dlr).Value = wsInvoice.Range("data2").Value
                        
                        'Order details
                        wsMaster.Range("J" & dlr).Value = wsInvoice.Range("E" & i & ":J" & i).Value
                        wsMaster.Range("K" & dlr).Value = wsInvoice.Cells(i, 4).Value
                        wsMaster.Range("L" & dlr).Value = wsInvoice.Cells(i, 11).Value
                        wsMaster.Range("M" & dlr).Value = wsInvoice.Cells(i, 12).Value
                    End If
                    
                    If wsInvoice.Cells(i, 4) <> "" And wsInvoice.Cells(i, 5) = "Discount" Then
                        wsMaster.Range("N" & dlr).Value = wsInvoice.Cells(i, 11).Value
                        wsMaster.Range("O" & dlr).Value = wsInvoice.Range("TOT").Value
                    End If
                Next i
            End If
            
            wbInvoice.Close False
            fso.MoveFile Invoice, strMoveFolderName & "\" & Invoice.Name
        End If
    End If
Next Invoice

'The Master Invoie File will be saved in this folder
strNewFolderPath = strSourceFolderPath & "\" & Format(Now, "dd-mmm-yy hhmmss")

'Name of the Master File
strNewFileName = "Master Invoice.xlsx"

fso.CreateFolder strNewFolderPath
With wsMaster.Range("A1").CurrentRegion
    .Borders.Color = vbBlack
    .Columns.AutoFit
End With

wbMaster.SaveAs strNewFolderPath & "\" & strNewFileName, 51
wbMaster.Close True
MsgBox "Master File has been saved successfully..." & vbNewLine & vbNewLine & _
        strNewFolderPath & "\" & strNewFileName, vbInformation
        
Skip:
xlApp.Quit
Set xlApp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub