Bagaimana cara menggabungkan beberapa lembar file Excel ke satu file Excel?

Saya perlu menggabungkan ratusan file Excel menjadi satu file Excel. Setiap file Excel perlu digabungkan ke dalam lembar kerja sendiri di buku kerja dan lembar kerja tujuan harus memiliki nama file asli (minus ekstensi). Apakah ini mungkin?

Yah, sepertinya Anda tidak berusaha melakukan ini, tetapi karena saya sudah memiliki makro ini ditulis, saya akan menyediakannya untuk orang lain yang mencari. Ini ditulis dalam excel 2007 dan merupakan bagian dari proses yang lebih besar.

Penting untuk dicatat bahwa ini akan gagal jika salah satu nama file Anda memiliki lebih dari 31 karakter, excel memiliki batas karakter untuk nama sheet

Gabungkan file menjadi satu dengan nama lembar kerja yang disetel ke nama file -

Sub CombineWSs()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String

    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    MyPath = "C:\Documents and Settings\path\to"
    Set wbDst = ThisWorkbook
    strFilename = Dir(MyPath & "\*.xls", vbNormal)

    If Len(strFilename) = 0 Then Exit Sub

    Do Until strFilename = ""

            Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)

            Set wsSrc = wbSrc.Worksheets(1)

            wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)

            wbSrc.Close False

        strFilename = Dir()

    Loop
    wbDst.Worksheets(1).Delete

    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Sekarang beralihlah ke sheet untuk menghapus lima karakter terakhir dari nama sheet: .xlsx

Sub RenameWS()
Application.ScreenUpdating = False
Dim strName As String
Dim intLength As Integer

For Each Sheet In ActiveWorkbook.Worksheets
    strName = Sheet.Name
    intLength = Len(strName)
    strName = Left(strName, intLength - 5)
    Sheet.Name = strName

Next
Application.ScreenUpdating = True
End Sub