Як об'єднати кілька аркушів файлів Excel в один файл Excel?

Мені потрібно об'єднати сотні файлів Excel в один файл Excel. Кожен файл Excel потрібно об'єднати у свій робочий аркуш у робочій книжці, а цільовий робочий аркуш повинен мати ім'я вихідного файлу (мінус розширення). Чи можливо це?

Ну, схоже, ви не доклали жодних зусиль до цього, але оскільки у мене вже є написані ці макроси, я поставляю їх усім, хто шукає. Вони були написані у відмінній 2007 році та були частиною більшого процесу.

Важливо зазначити, що це не вдасться, якщо будь-яке з ваших імен файлів має більше 31 символу, у excel є обмеження кількості символів для аркушів

Об'єднайте файли в одне ім'я робочих таблиць, встановлених на ім'я файлу -

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

Тепер перейдіть через аркуші, щоб видалити останні п'ять символів назви аркуша: .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