Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 02.03.2017, 21:56   #1
yvcher19
 
Регистрация: 02.03.2017
Сообщений: 8
По умолчанию Выполнить код в цикле для всех листов Excel-таблицы в VBA

Добрый день!
Форумчане помогите довести до ума.
Есть файл, в нем много листов, и есть один итоговый куда тянется информация со всех этих листов. Я понял как сделать команду для каждого листа, но листов очень много и писать для каждого - нереально, как можно сделать цикл в данной ситуации? Прошу помощи.....
Пример документа на форум залить не получается, вот ссылка 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
yvcher19 вне форума Ответить с цитированием
Старый 02.03.2017, 22:53   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Цитата:
Сообщение от yvcher19 Посмотреть сообщение
как можно сделать цикл
Поиск не помог?
http://www.programmersforum.ru/showthread.php?t=130733
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 03.03.2017, 00:57   #3
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

это покатит для всех листов
Код:
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
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете

Последний раз редактировалось IgorGO; 03.03.2017 в 01:04.
IgorGO вне форума Ответить с цитированием
Старый 03.03.2017, 13:01   #4
yvcher19
 
Регистрация: 02.03.2017
Сообщений: 8
По умолчанию

Спасибо!
yvcher19 вне форума Ответить с цитированием
Старый 07.03.2017, 14:18   #5
yvcher19
 
Регистрация: 02.03.2017
Сообщений: 8
По умолчанию

Цитата:
Сообщение от 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"?

Спасибо за помощь
yvcher19 вне форума Ответить с цитированием
Старый 07.03.2017, 15:24   #6
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Код:
For Each ws In Worksheets
If InStr("@Svod@Лист1@Лист2@", "@"& ws.Name &"@") = 0  Then
....
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 07.03.2017, 16:11   #7
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

Код:
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
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 07.03.2017, 16:51   #8
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Игорь, а как распределяется .Index по листах? Не может Лист1.index>Svod.index?
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 07.03.2017, 17:12   #9
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

индексы листов соотв. их позиции в списке ярлыков листов
самый левый ярлык имеет индекс 1, самый правый - имеет индекс равный worksheets.count (Саша, и все это элементарно проверяется эмпирическим путем)))
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 09.03.2017, 08:35   #10
yvcher19
 
Регистрация: 02.03.2017
Сообщений: 8
По умолчанию

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


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Макрос для всех листов albih Microsoft Office Excel 3 12.04.2012 14:16
Макрос для всех листов as-is Microsoft Office Excel 8 10.02.2011 21:15
При пересчете значений в ячейке, форма VBA не дает выполнить код. segail Microsoft Office Excel 11 29.06.2010 23:09
Макрос для всех листов в книге Rok Microsoft Office Excel 5 26.04.2010 08:55