Question

我是宏观新手，需要帮助。我在一个文件夹中有很少的工作簿，每个工作簿有四个工作表。现在我想要一个mocro从每个工作簿中复制数据（工作表明智）和过去在我的主工作簿（工作表明智）中表示sheet1的数据应分别粘贴在我的主工作簿中的sheet1和sheet 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

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

1 个答案: