Как объединить несколько листов файлов Excel в один файл Excel?

Question

Мне нужно объединить сто файлов Excel в один файл Excel. Каждый файл Excel должен быть объединен в отдельную рабочую таблицу в рабочей книге, а конечная рабочая таблица должна иметь имя исходного файла (за вычетом расширения). Это возможно?

Answer 1

Не похоже, что вы приложили к этому какие-либо усилия, но, поскольку у меня уже есть эти макросы, я предоставлю их всем, кто ищет. Они были написаны в 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