在EXCEL中用宏批量跨工作薄复制工作表

Sub test()
Dim BookA As Workbook, BookB As Workbook, mPath As String, mFile As String
On Error Resume Next '错误继续
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set BookA = ThisWorkbook
mPath = "C:\users\administrator\desktop\新建文件夹\"   '设置路径
mFile = Dir(mPath & "\*.xls*")
Do While mFile <> ""
    If mFile <> BookA.Name Then
        Set BookB = Workbooks.Open(mPath & mFile, , False)
        BookA.Worksheets("Sheet2").Copy after:=BookB.Worksheets(BookB.Worksheets.Count)   '将样本工作表添加到目标工作簿
        BookB.Close True
    End If
mFile = Dir
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "处理完成！"
End Sub

私信我联系方式，我帮你写个吧

"sheet3"改为sheets("sheet3")
目测后面还有错误