Выполнить код в цикле для всех листов Excel-таблицы в VBA

[yvcher19]

Добрый день!
Форумчане помогите довести до ума.
Есть файл, в нем много листов, и есть один итоговый куда тянется информация со всех этих листов. Я понял как сделать команду для каждого листа, но листов очень много и писать для каждого - нереально, как можно сделать цикл в данной ситуации? Прошу помощи.....
Пример документа на форум залить не получается, вот ссылка https://drive.google.com/open?id=0B-...WRha1JzMnFiV0U

Sub filter()
e1 = sheets("1").Cells(sheets("1").Rows. Count, 3).End(xlUp).Row
If sheets("1").Cells(2, 3) <> "" Then
sheets("1").Activate
sheets("1").Range("A2:S2" & e1).Select
Selection.Copy
sheets("Svod").Activate
Application.Goto (ActiveWorkbook.sheets("Svod").Rang e("A7"))
ActiveSheet.Paste Destination:=Worksheets("Svod").Ran ge("A7")
sheets("1").Activate
End If

e1 = sheets("2").Cells(sheets("2").Rows. Count, 3).End(xlUp).Row
e2 = sheets("Svod").Cells(sheets("Svod") .Rows.Count, 1).End(xlUp).Row
If sheets("2").Cells(2, 3) <> "" Then
sheets("2").Activate
sheets("2").Range("A2:S2" & e1).Select
Selection.Copy
sheets("Svod").Activate
Application.Goto (ActiveWorkbook.sheets("Svod").Rang e("A" & e2 + 1))
ActiveSheet.Paste Destination:=Worksheets("Svod").Ran ge("A" & e2 + 1)
End If

e1 = sheets("3").Cells(sheets("3").Rows. Count, 3).End(xlUp).Row
e2 = sheets("Svod").Cells(sheets("Svod") .Rows.Count, 1).End(xlUp).Row
If sheets("3").Cells(2, 3) <> "" Then
sheets("3").Activate
sheets("3").Range("A2:S2" & e1).Select
Selection.Copy
sheets("Svod").Activate
Application.Goto (ActiveWorkbook.sheets("Svod").Rang e("A" & e2 + 1))
ActiveSheet.Paste Destination:=Worksheets("Svod").Ran ge("A" & e2 + 1)
End If
End Sub

[Aleksandr H.]

Сообщение от yvcher19

как можно сделать цикл

Поиск не помог?
http://www.programmersforum.ru/showthread.php?t=130733

[IgorGO]

это покатит для всех листов

Sub Banzay()
  Dim ws As Worksheet, rg As Range
  For Each ws In Worksheets
    If ws.Name <> "Svod" Then
      Set rg = ws.Cells(Rows.Count, 1).End(xlUp)
      If rg.Row > 2 Then Range(rg, ws.Cells(2, 19)).Copy Worksheets("Svod").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End If
  Next
End Sub

[yvcher19]

Спасибо!

[yvcher19]

Сообщение от IgorGO

это покатит для всех листов
Код:

Sub Banzay()
Dim ws As Worksheet, rg As Range
For Each ws In Worksheets
If ws.Name <> "Svod" Then
Set rg = ws.Cells(Rows.Count, 1).End(xlUp)
If rg.Row > 2 Then Range(rg, ws.Cells(2, 19)).Copy Worksheets("Svod").Cells(Rows.Count , 1).End(xlUp).Offset(1, 0)
End If
Next
End Sub

Igor, подскажите, если в книге имеются листы которые расположены после листа SVOD, и с них тоже не нужно брать информацию, просто необходимо их всех указать?
Пример:
If ws.Name <> "Svod" Then
If ws.Name <> "Лист1" Then
If ws.Name <> "Лист2" Then


Или можно приминить данный макрос на все листы книги расположенные до листа "SVOD"?

Спасибо за помощь

[Aleksandr H.]

For Each ws In Worksheets
If InStr("@Svod@Лист1@Лист2@", "@"& ws.Name &"@") = 0  Then
....

[IgorGO]

Sub Banzay()
  Dim ws As Worksheet, rg As Range
  For Each ws In Worksheets
    If ws.Index < worksheets("Svod").Index Then
      Set rg = ws.Cells(Rows.Count, 1).End(xlUp)
      If rg.Row > 2 Then Range(rg, ws.Cells(2, 19)).Copy Worksheets("Svod").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End If
  Next
End Sub

[Aleksandr H.]

Игорь, а как распределяется .Index по листах? Не может Лист1.index>Svod.index?

[IgorGO]

индексы листов соотв. их позиции в списке ярлыков листов
самый левый ярлык имеет индекс 1, самый правый - имеет индекс равный worksheets.count (Саша, и все это элементарно проверяется эмпирическим путем)))

[yvcher19]

IgorGO, спасибо огромное, все работает. Только заметил одну особенность,или может это баг, если первая ячейка с которой эксель начинает копирование пустая ( например у нас заполнена вся 2ая строка, но первая ячейка пустая) - то почему то тянется ячейка сверху нее.