I have not tested this. It would take some effort to replicate your setup. Please let me know if there are any problems and be specific if something doesn't work.
Dim wbData As Workbook, wbMain As Workbook, wsMain As Worksheet, wsData As Worksheet
Dim LR As Long, NR As Long, fPath As String, fName As String
Dim F As Long ' file index
Dim FNum As Long ' file number from file name
Dim FileNames(1 To 20) As String
Dim a As Variant
Set wbMain = ThisWorkbook
fPath = "Z:\Demand & Supply\Demand & Supply\3.Color Breakdown 2.0\Sep_Oct'15 Production - Testing\3.Master\"
fName = Dir(fPath & "*.xlsm")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error Resume Next
Do While Len(fName) > 0
If fName <> ThisWorkbook.Name Then
a = Split(fName, ".")
FNum = a(0)
FileNames(FNum) = fName
End If
fName = Dir
Loop
For F = 1 To 20
fName = a(F)
If fName = "" Then
MsgBox "File #" & F & " was not found."
Else
Set wbData = Workbooks.Open(fPath & fName)
For Each wsData In wbData.Worksheets
Set wsMain = wbMain.Sheets(wsData.Name)
If Not wsMain Is Nothing Then
NR = wsMain.Range("A" & Rows.Count).End(xlUp).Row + 1
With wsData
LR = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A4:A" & LR).EntireRow.Copy wsMain.Range("A" & NR)
End With
Set wsMain = Nothing
End If
Next wsData
wbData.Close False
End If
Next F
Bookmarks