将多个工作簿中的多个工作表中的数据复制到单个主工作簿中

Question

I am new to macro and needs help. I have few workbooks in a folder and each workbook has four worksheets. now I want a mocro which copy data from each workbook (worksheet wise) and past in my master workbook (worksheet wise) means data of sheet1 shoud be pasted one below the other in my master workbook in sheet1 and sheet 2 respectively.*Workbook name could be anything in folder. Can anyone help me with entire code to do that? I have macro to colate data from one sheet to my assigned sheet but it copy paste data from open sheet only not by sheet name wise. Can anyone help to make corrections in my below code :

Sub Ref_Doc_Collation()
Dim MyFile As String
Dim erow
Dim Filepath As String
Application.ScreenUpdating = False
Filepath = "\\NAMDFS\TPA\MWD\USERS\ay86009\Referral_Doc\"
MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
If MyFile = "Referral_Doc_Collation.xlsm" Then
Exit Sub
End If

Workbooks.Open (Filepath & MyFile)
Sheets("Allocation").Range("B2:L3000").Copy
Application.DisplayAlerts = False

erow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Allocation").Range(Cells(erow, 2), Cells(erow, 12))

activesheet.next.select

Sheets("Prefetcher").Range("B2:I3000").Copy
Application.DisplayAlerts = False

erow = Sheet2.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Prefetcher").Range(Cells(erow, 2), Cells(erow, 9))

activesheet.next.select

Sheets("Matrix").Range("B2:G3000").Copy
Application.DisplayAlerts = False

erow = Sheet3.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Matrix").Range(Cells(erow, 2), Cells(erow, 7))

activesheet.next.select

Sheets("Follow ups").Range("B2:H3000").Copy
Application.DisplayAlerts = False

erow = Sheet4.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Follow ups").Range(Cells(erow, 2), Cells(erow, 8))


ActiveWorkbook.Close
MyFile = Dir

Loop
Application.ScreenUpdating = True
MsgBox "DONE"
End Sub

Answer 1

Compiled but not tested:

Sub Ref_Doc_Collation()

    Const FILE_PATH As String = "\\NAMDFS\TPA\MWD\USERS\ay86009\Referral_Doc\"
    Const SKIP_FILE As String = "Referral_Doc_Collation.xlsm"

    Dim MyFile As String, wb As Workbook

    Application.ScreenUpdating = False

    MyFile = Dir(FILE_PATH)

    Do While Len(MyFile) > 0

        If MyFile <> SKIP_FILE Then

            Set wb = Workbooks.Open(FILE_PATH & MyFile)

            wb.Sheets("Allocation").Range("B2:L3000").Copy _
                ThisWorkbook.Sheets("Allocation").Cells(Rows.Count, "B"). _
                   End(xlUp).Offset(1, 0)

            wb.Sheets("Prefetcher").Range("B2:I3000").Copy _
                ThisWorkbook.Sheets("Prefetcher").Cells(Rows.Count, "B"). _
                   End(xlUp).Offset(1, 0)

            wb.Sheets("Matrix").Range("B2:G3000").Copy _
                ThisWorkbook.Sheets("Matrix").Cells(Rows.Count, "B"). _
                   End(xlUp).Offset(1, 0)

            wb.Sheets("Follow ups").Range("B2:H3000").Copy _
                ThisWorkbook.Sheets("Allocation").Cells(Rows.Count, "B"). _
                   End(xlUp).Offset(1, 0)

            wb.Close False

        End If

        MyFile = Dir

    Loop

    Application.ScreenUpdating = True
    MsgBox "DONE"

End Sub