Объединить в один файл

[asale]

Добрый день.
В папке есть 20 файлов по 1 листу в каждом (одинаковые таблицы,только данные разные).
Возможно макросом объединить их все в одну книгу? Чтобы каждая таблица была на листе, т.е. чтобы в итоговом файле стало 20 листов?

Возможно ли это?

[IgorGO]

Конечно, возможно.
Есть несколько условий:
1. В папке должны находиться только необходимые для обработки файлы (или их необходимо будет выбирать по одному, вручную)
2. Файлы должны содержать по одному листу, или необходимые листы должны одинаково называться, или на этих листах должны быть такие данные, по которым их можно однозначно отличить от всех остальных в книге.

И последнее, если Вам необходимо по три раза каждый день, собирать листы с 20 книг в одну книгу - есть смысл дождаться макроса здесь, а если это разовая задача - проще все проделать ручками..., тем более, что у меня есть подозрения, что все это не обойдется без подготовительных работ, которые точно могут быть выполнены только ручками, для обеспечения выполнения условий 1 и 2

[SAS888]

Например, так:

Sub CombineWorkbooks()
    Dim CurFile As String
    Dim DestWB As Workbook
    Dim ws As Object 'Рабочие листы могут быть произвольного типа.
    
    Const DirLoc As String = "C:\Temp\" 'Местоположение исходных файлов.
    Application.ScreenUpdating = False
    Set DestWB = Workbooks.Add(xlWorksheet)
    CurFile = Dir(DirLoc & "*.xls")
    
    Do While CurFile <> vbNullString
        Dim OrigWB As Workbook
        Set OrigWB = Workbooks.Open(Filename:=DirLoc & CurFile, ReadOnly:=True)
        CurFile = Left(Left(CurFile, Len(CurFile) - 4), 29)
        
'Получение базового имени рабочего листа путем отсечения последних 4-х символов имени исходного файла (".xls").

        For Each ws In OrigWB.Sheets
            ws.Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
            If OrigWB.Sheets.Count > 1 Then
                DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile & ws.Index
            Else
                DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile
            End If
        Next
        OrigWB.Close SaveChanges:=False
        CurFile = Dir
    Loop
    
    Application.DisplayAlerts = False
    DestWB.Sheets(1).Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Set DestWB = Nothing
    
End Sub