如何将一个文件夹中多个 excel 工作簿中除工作表 1 和 2 之外的所有工作表复制到另一个工作簿中

Question

I really appreciate if someone here would help me crack this problem which i cant find the solution (and sorry for my bad english).

So i have multiple excels in one folder. every excel in it have same format 1st sheet for reference of every sheet, 2nd sheet for consolidation data, and 3rd sheet and the rest for the data to be consolidated. Every excel in the folder have various amount of sheet.

What i want to do is i want to copy data from range A27:AJ500 that begin from 3rd sheet to every sheet after, into another new workbook in sheet1 and paste it begin from cell A27 over and over into the bottom and looping for every excel in folder.

i dont have enough ability yet to write my own script but i managed to understand some and combine it into this script.

Sub Download_Data()

Path = "C:\Users\ASUS\Desktop\Done\"
Filename = Dir(Path & "*.xlsm")

'to open every excel in my folder
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True '--> i only managed to do it right till here

'supposed to copy range in every sheet of excel in my folder into different workbook
For Each ws In thiswoorkbook.Worksheets '--> i try write this code but i am confused to do what i want from here and i know this code is nowhere near true
    With ws
        If .Name <> "GABUNGAN" Then
        range("A27:AJ500").Select
        Selection.copy
        Workbooks("Tes.xlsm").range("A27").PasteSpecial Paste:=xlPasteValues
        End If
    End With
Next ws

Workbooks(Filename).Close
Filename = Dir()
Loop

Application.Goto ActiveWorkbook.Sheets("sheet1").range("A1")

End Sub

I've been searching for the code not only i cant customize it to this code but also i cant understand what is wrong in the code therefore i write this question. Any help will be appreciated, thanks in advance for your attention wish you safe and sound.

Answer 1

Try this: (tested)

Dim sourcewb As Workbook
Dim destwb As Workbook
Dim y As Long
Dim ws As Worksheet
Dim strPath As String, strFilename As String

strPath = "C:\Users\ASUS\Desktop\Done\"
strFilename = Dir(strPath & "*.xlsm")

y = 27
Set destwb = ThisWorkbook
Do While strFilename <> ""
    Set sourcewb = Workbooks.Open(Filename:=strPath & strFilename, ReadOnly:=True)
    For Each ws In sourcewb.Worksheets
        With ws
            If .Name <> "name of reference sheet" And .Name <> "name of consolidation sheet" Then
                .Range("A27:AJ500").Copy
                destwb.Worksheets("sheet1").Range("A" & y).PasteSpecial Paste:=xlPasteValues
                y = y + (500 - 27) + 1
            End If
        End With
    Next ws
    sourcewb.Close False
    strFilename = Dir()
Loop