Копирование файлов постранично

[andre48]

Здравствуйте, уважаемые! с праздником милые дамы (если такие тут есть)
Я недавно начал пытаться программировать, так что пожалуйста не смейтесь если что-нибудь ляпну.
Передо мной стоит задача - скопировать из одного файла Excel в другой таблицы, постранично, т.е: в исходном файле из листа1 копируется таблица в лист1 второго файла, из листа2 в лист2 и так 50 страниц.
для одной страницы я, почитав ваш прекрасный форум, сумел написать программу, а вот для всех 50 страниц не могу написать ничего работающего, кроме повторения 50 раз этого кода =))
возможно ли как-нибудь поизящнее решить такую проблему?
и насколько медленнее будет моя программа по сравнению с оптимизированной?

[EducatedFool]

Попробуйте такой вариант:

Sub CopyAll()
    On Error Resume Next ' отключаем останов при возникновении ошибок
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = "c:\": .FilterIndex = 3: .AllowMultiSelect = False
        If .Show = -1 Then Filename = .SelectedItems(1) Else Exit Sub
    End With

    Application.ScreenUpdating = False
    Dim wb1 As Workbook, sh1 As Worksheet, ra1 As Range

    Set wb1 = Workbooks.Open(Filename)
    If wb1 Is Nothing Then Exit Sub

    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets    ' перебираем все листы в текущей книге
        Err.Clear    ' сбрасываем ошибки
        Set sh1 = Nothing: Set ra1 = Nothing ' очищаем переменные
        
        Set sh1 = wb1.Worksheets(CStr(sh.Name))  ' ищем в открытой книге лист с таким же именем
        
        ' получаем диапазон для копирования
        Set ra1 = sh1.Range(sh1.[e6], sh1.Range("a" & sh1.Rows.Count).End(xlUp).Offset(1))
        
        ' копируем диапазон с листа открытой книги
        ' и вставляем на одноимённый лист текущей книги
        ra1.Copy sh.Range("b" & sh.Rows.Count).End(xlUp).Offset(1)
        
        If Err Then ' проверяем, произошли ли ошибки при копировании текущего листа
            Debug.Print "В книге """ & wb1.Name & """ нет листа с именем """ & sh.Name & """  - копирование не удалось"
        Else
            Debug.Print "Лист """ & sh.Name & """ удачно скопирован"
        End If
    Next sh
    
    wb1.Close False    ' закрываем открытую ранее книгу без сохранения изменений
End Sub

В окне Immediate (открывается по Ctrl + G) видим отчёт:

Лист "Лист1" удачно скопирован
В книге "Книга6.xls" нет листа с именем "Лист4" - копирование не удалось
В книге "Книга6.xls" нет листа с именем "Лист2" - копирование не удалось

[andre48]

большое спасибо!!! работает!
EducatedFool, Вы Мастер!