копировать данные из нескольких листов в нескольких книгах, все в одну основную рабочую книгу

Question

Я новичок в макросе и нуждаюсь в помощи. У меня мало книг в папке, и каждая книга имеет четыре листа. теперь я хочу, чтобы mocro, который копировал данные из каждой книги (рабочий лист мудрый) и прошёл в моей основной книге (рабочий лист мудрый), означает, что данные листа1 будут вставлены один под другим в моей основной книге в листах 1 и 2 соответственно. * Название книги может быть что угодно в папке. Может ли кто-нибудь помочь мне со всем кодом для этого? У меня есть макрос для сортировки данных с одного листа на мой назначенный лист, но он копирует данные пасты с открытого листа только не по имени листа. Может кто-нибудь поможет внести коррективы в мой код ниже:

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

Составитель но не тестировалось:

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