Question : concatenate multiple excel files?

I'm looking to concatenate multiple excel files that are same format and located in the same directory.  I attached  examples of the files.
Attachments:
 
expo140D50.xls (2.7 MB) (File Type Details) 
inventory export file
 
 
expo9618D99.xls (695 KB) (File Type Details) 
another inventory export file
 

Answer : concatenate multiple excel files?

Third time pays for all. Final update with working solution (correction of line 17)
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:

Private Sub LoopThroughXLS_ConsolidateOneSheet()
'opens all workbooks in a folder and consolidate them in one sheet on the active workbook
application.ScreenUpdating = False 'disable screen updating to avoid screen flashing
Dim wbk1 As Workbook, wbk2 As Workbook, i As Long, strWbk As String, sht1 As Worksheet
Dim blFirst As Boolean
Dim strWbkNames(1 To 500) As String, FileName As String, intFileCount As Long, intWbkLoop As Long

'***************UPDATE PARAMETERS HERE*************************
Const strpath As String = "C:\Temp\test" 'Change to the folders where you drop your files
Const blHeader As Boolean = True 'true if your data has headers, false otherwise
'**************************************************************

Set wbk1 = ActiveWorkbook
Set sht1 = ActiveSheet
blFirst = True

FileName = Dir(strpath & "\*.xls")
   Do While FileName <> ""
      intFileCount = intFileCount + 1
      strWbkNames(intFileCount) = FileName
      FileName = Dir
   Loop

application.DisplayAlerts = False

For intWbkLoop = 1 To intFileCount

    If application.WorksheetFunction.CountA(sht1.Columns(1)) = 0 Then
        sht1.range("A1").Select
    Else
        sht1.range("A" & sht1.Rows.Count).End(xlUp).Offset(1, 0).Select
    End If
    
    Set wbk2 = Workbooks.Open(strpath & "\" & strWbkNames(intWbkLoop))
    
    With wbk2.Sheets(1)
        If blFirst = True Then
            blFirst = False
            .UsedRange.Copy
        Else
            If blHeader = True Then
                .UsedRange.Offset(1).Copy
            Else
                .UsedRange.Copy
            End If
        End If
    End With
    
    sht1.Paste
    wbk2.Close (False)
Next

application.DisplayAlerts = True
application.ScreenUpdating = True
End Sub
Random Solutions  
 
programming4us programming4us