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

Question

I am trying to use VBA in order to automate a boring work process. I don't know the language so I copied a code from the internet which is as follows:

Problem statement: I have multiple excel files in one folder, from them I have to extract a single sheet named "sheet 1" (all the files have it, but sheet1 isn't the only sheet those workbooks have) .

Then I have to paste them in a new workbook. (I don't mind if each of them are in different sheet, because I'll just record a macro to compile them later on)**

Does anyone have any suggestions?

   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

Below code takes the first sheet in every file and names the sheet to the filename.

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