从多个工作簿复制单个工作表并粘贴到单个工作簿中

Question

我正在尝试使用 VBA 来自动化无聊的工作流程。 我不懂语言，所以我从互联网上复制了一个代码，如下所示：

问题陈述：我在一个文件夹中有多个 excel 文件，我必须从中提取一张名为“sheet 1”的工作表（所有文件都有它，但 sheet1 不是这些工作簿唯一的工作表） 。

然后我必须将它们粘贴到一个新的工作簿中。 （我不介意它们是否在不同的工作表中，因为我只会记录一个宏以便稍后编译它们）**

有没有人有什么建议？

   Sub Combine_files()
Dim Path As String
Dim Filename As String
Dim Sheet As Worksheet

Path = "C:\Users\prayag.purohit\OneDrive\Desktop\Project KC\New folder\"
Filename = Dir(Path & "*.xlsx")
Do While Filename <> ""

Workbooks.Open Filename:=Path & Filename, ReadOnly:=True

    For Each Sheet In ActiveWorkbook.Sheets
        Sheet.Copy After:=ThisWorkbook.Sheets(1)
    Next Sheet

Workbooks(Filename).Close

Filename = Dir()
Loop
End Sub

Answer 1

下面的代码获取每个文件中的第一个工作表，并将工作表命名为文件名。

Option Explicit

Sub Combine_files()
Dim Path As String, Filename As String
Dim wbFile As Workbook, wbActive As Workbook
Set wbActive = ActiveWorkbook
Path = "C:\Users\prayag.purohit\OneDrive\Desktop\Project KC\New folder\"
Filename = Dir(Path & "*.xlsx")

With Application
    .ScreenUpdating = False
End With

Do While Filename <> ""

Set wbFile = Workbooks.Open(Path & Filename, False, True)
wbFile.Sheets(1).Copy After:=wbActive.Sheets(1)
wbActive.Sheets(2).Name = Filename
wbFile.Close SaveChanges:=False

Filename = Dir()
Loop

wbActive.Sheets(1).Select

With Application
    .ScreenUpdating = True
End With

End Sub