Как улучшить макрос?!

[Gerek]

Добрый день!
Подскажите, пожалуйста, есть следующий макрос:

Sub Макрос1()
Sheets("26.06.09").Select
Range("A2:L3").Select
Selection.Copy
Sheets("Лист1").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("27.06.09").Select
Range("A2:L3").Select
Selection.Copy
Sheets("Лист1").Select
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Select
ActiveSheet.Paste
End Sub

Его задача копировать определенные строчки из нескольких листов книги в один. На данный момент для работы макроса нужно точно прописывать название листа, к сожалению, названия и количество листов в книге заранее не известны… Соответственно вопрос, как переделать этот макрос, чтобы он копировал нужные строки со всех листов книги в независимости от их названия и количества? Заранее спасибо за ответ!

[mc-black]

Используй перебор элементов коллекции. В твоем случае это листы, надо организовать цикл For Each ... In ... Next для коллекции Worksheets, пропускать только один лист назначения с известным названием ("Лист1")
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
Например, вот так:

Код: Выделить всё

Sub SheetsEnumerator()
    Dim i As Long
    Dim wsh As Worksheet
    Dim dst As Worksheet
    
    Set dst = ThisWorkbook.Worksheets("Ëèñò1")
    
    i = 2 ' Номер первой строки для вывода данных
    Do While Not dst.Cells(i, 1).Value = Empty
        i = i + 1
    Loop
    
    For Each wsh In ThisWorkbook.Worksheets
        If wsh.Name <> dst.Name Then
            wsh.Range(wsh.Cells(2, 1), wsh.Cells(3, 12)).Copy _
                dst.Cells(i, 1)
            i = i + 2
        End If
    Next
    
    Set dst = Nothing
End Sub

[SAS888]

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

Код: Выделить всё

Sub Main()
    Dim sh1 As Worksheet, sh2 As Worksheet, i As Long
    Set sh2 = Sheets("Лист1"): Application.ScreenUpdating = False
    For i = sh2.UsedRange.Row + sh2.UsedRange.Rows.Count To 3 Step -1
        If Rows(i - 1).Text = "" Then Else Exit For
    Next
    For Each sh1 In ThisWorkbook.Worksheets
        If sh1.Name <> sh2.Name Then
            sh1.[A2:L3].Copy sh2.Cells(i, 1): i = i + 2
        End If
    Next
End Sub

Это позволит отыскать именно первую пустую строку после последней заполненной, не зависимо от столбцов, границ ячеек, заливки и т.п.
Если же этого не требуется, то вместо первого цикла в макросе нужно вставить очистку диапазона для вставки и присвоить i = 2.

[Gerek]

Большое спасибо Вам за ответы!
Подскажите, пожалуйста, что нужно изменить в приведенных макросах для того, чтобы вставка данных происходила как значения?

[SAS888]

Строку

Код: Выделить всё

sh1.[A2:L3].Copy sh2.Cells(i, 1): i = i + 2

замените на

Код: Выделить всё

sh1.[A2:L3].Copy: sh2.Cells(i, 1).PasteSpecial Paste:=xlPasteValues: i = i + 2

[mc-black]

SAS888,
Спасибо большое за улучшение кода! Объясни мне пожалуйста, чем твой способ поиска первой пустой строки выигрывает у моего простого примера? Просто я использую свой способ уже долгое время для поиска именно первой пустой ячейки (не строки) для столбцов, которые сплошь до конца таблицы всегда по смыслу чем-нибудь заполнены. Обычно это какой-то код или порядковый номер в первом столбце. Всегда меня мой подход устраивал... ну разве что по быстродействию он медленней, чем dst.Cells(1,1).End(xlDown).Row+1, но такой способ приводит к ошибке, если список пуст - значение слетает в 65536+1 (App. Error - owerflow).
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
Почему бы

If Rows(i - 1).Text = "" Then Else Exit For

не записать как

If Rows(i - 1).Text <> "" Then Exit For

?

[SAS888]

mc-black,
Пусть есть лист с данными. И пусть требуется найти первую строку, после последней заполненной.

1. Применяя Ваш способ, нужно либо точно знать, что на листе нет данных ниже, чем последняя заполненная ячейка в контролируемом столбце, либо проверять все столбцы и выбирать наибольшее значение номера строки. Согласны?

2. Если просто использовать i = sh2.UsedRange.Row + sh2.UsedRange.Rows.Count, то это тоже не правильно, т.к. в .UsedRange входят не только ячейки с данными, но и ячейки имеющие заливку, границы, формулы и т.п.

3. Предложенная мной проверка If Rows(i).Text = "" принимает значение True, если в строке i пусто во всех столбцах. Нет необходимости их перебирать.


P.S. Ищем не первую попавшуюся пустую строку, а именно первую строку, после последней заполненной. Хотя если потребуется первое, то все равно считаю, что лучше использовать If Rows(i).Text = ""

[mc-black]

Большое спасибо, SAS888!
Разобрался, много нового для себя узнал. Буду пользоваться предложенным способом.