Excel vba перебор всех листов книги

Перебор листов в книге Excel циклом For Each… Next с копированием данных из этих листов и вставкой в новый лист той же книги с помощью кода VBA.

Условие задачи по перебору листов

Есть книга Excel с неизвестным количеством рабочих листов с данными. Необходимо выполнить следующие действия:

  • открыть книгу;
  • создать новый лист;
  • запустить цикл перебора листов;
  • скопировать данные из столбца «B» каждого листа и вставить в новый лист;
  • данные из очередного листа вставлять в следующий столбец нового листа, а в верхнюю ячейку столбца записывать имя листа, из которого данные скопированы.

Для открытия книги (получения полного имени) будем использовать диалоговое окно выбора файлов GetOpenFilename, а для перебора листов — цикл For Each… Next.

Пример кода для перебора листов в книге Excel циклом For Each… Next с частичным копированием данных на отдельный лист:

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

Sub CopyDataFromAllSheets()

Dim wb As Workbook, newws As Worksheet, ws As Worksheet, n As Long

n = 1

‘Выбираем, открываем нужную книгу и присваиваем ссылку на нее переменной wb

Set wb = Workbooks.Open(Application.GetOpenFilename(«Файлы Excel,*.xls*», , «Выбор файла»))

‘Создаем в открытой книге новый лист и присваиваем ссылку на него переменной newws

Set newws = wb.Worksheets.Add

    With newws

        ‘Присваиваем имя новому листу: «Отчет от dd.mm.yyyy»

        .Name = «Отчет от « & Date

            ‘Запускаем цикл, перебирающий листы

            For Each ws In wb.Worksheets

                ‘Проверяем, что имя текущего листа не равно имени нового листа «Отчет…»

                If ws.Name <> newws.Name Then

                    ‘Копируем столбец «B» текущего листа на лист «Отчет…» в столбец n

                    ws.Columns(«B»).Copy Destination:=.Columns(n)

                    ‘Добавляем ячейку cверху столбца n

                    .Cells(1, n).Insert Shift:=xlShiftDown

                    ‘Записываем в добавленную ячейку имя текущего листа

                    .Cells(1, n) = ws.Name

                    ‘Задаем тексту в добавленной ячейке полужирное начертание

                    .Cells(1, n).Font.Bold = True

                    n = n + 1

                End If

            Next

    End With

End Sub

При использовании метода копирования диапазонов, на новый лист будут перенесены не только значения ячеек, но и их форматы. Если необходимо перенести только значения, можно, в качестве промежуточного звена, использовать массив.

Источник

Аннотация

Данная статья содержит Microsoft Visual Basic для приложений макроса (процедура Sub), который в цикле проходит через все листы активной книги. Этот макрос также отображается имя каждого листа.

Дополнительная информация

Корпорация Майкрософт предлагает примеры программного кода только для иллюстрации и без гарантии или подразумеваемых. Это включает, но не ограничиваясь, подразумеваемые гарантии товарной пригодности или пригодности для определенной цели. В данной статье предполагается, что вы знакомы с демонстрируемым языком программирования и средствами, которые используются для создания и отладки. Сотрудники службы поддержки Майкрософт могут объяснить возможности конкретной процедуры, но не выполнять модификации примеров для обеспечения дополнительных функциональных возможностей или создания процедур для определенных требований. Пример макроса, выполните следующие действия:

  1. Введите следующий код макроса в лист модуля.

          Sub WorksheetLoop()         Dim WS_Count As Integer         Dim I As Integer         ' Set WS_Count equal to the number of worksheets in the active         ' workbook.         WS_Count = ActiveWorkbook.Worksheets.Count         ' Begin the loop.         For I = 1 To WS_Count            ' Insert your code here.            ' The following line shows how to reference a sheet within            ' the loop by displaying the worksheet name in a dialog box.            MsgBox ActiveWorkbook.Worksheets(I).Name         Next I      End Sub

  2. Чтобы запустить макрос, поместите курсор в строку, которая считывает «Sub WorksheetLoop()» и нажмите клавишу F5.

Макрос будет цикла книги и отображает окно сообщения с именем другого листа при каждом выполнении цикла. Обратите внимание, что этот макрос будет отображать только имена листов; он будет отображаться имена других типов листов в книге. Можно также использовать цикл через все листы в книге с помощью цикла «For Each».

  1. Введите следующий код макроса в лист модуля.

          Sub WorksheetLoop2()         ' Declare Current as a worksheet object variable.         Dim Current As Worksheet         ' Loop through all of the worksheets in the active workbook.         For Each Current In Worksheets            ' Insert your code here.            ' This line displays the worksheet name in a message box.            MsgBox Current.Name         Next      End Sub

  2. Чтобы запустить макрос, поместите курсор в строку, которая считывает «Sub WorksheetLoop2()» и нажмите клавишу F5.

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

Ссылки

Дополнительные сведения о получении справки по Visual Basic для приложений обратитесь к следующей статье Microsoft Knowledge Base:

163435 VBA: программные ресурсы для Visual Basic для приложений

226118 OFF2000: программные ресурсы для Visual Basic для приложений

Нужна дополнительная помощь?

Источник

Ill show you how to loop through all of the worksheets in a workbook in Excel using VBA and Macros.

This only takes a few lines of code and is rather simple to use once you understand it.

Here is the macro that will loop through all worksheets in a workbook in Excel:

Sub Sheet_Loop()
'count the number of worksheets in the workbook
sheet_count = ActiveWorkbook.Worksheets.Count

'loop through the worksheets in the workbook
For a = 1 To sheet_count

    'code that you want to run on each sheet
    
    'simple message box that outputs the name of the sheet
    MsgBox ActiveWorkbook.Worksheets(a).Name

Next a
End Sub

Now, Ill go through the macro step-by-step.

ActiveWorkbook.Worksheets.Count

This line is what counts the number of worksheets that are in the workbook.

The first part of the line simply sets the variable sheet_count equal to the number of sheets in the workbook:

sheet_count = ActiveWorkbook.Worksheets.Count

Now that we know how many worksheets there are, we can loop through them.

We are going to use a very simple For Next loop in this case and you can copy it directly from here into your project.

For a = 1 To sheet_count
'code that you want to run on each sheet
Next a

In the above lines we are creating a new variable a and setting it equal to 1.  We then use the sheet_count variable to tell the macro when to stop looping; remember that it holds the numeric value of how many sheets there are in the workbook.

After this first line, which creates the loop, we then put all of the code that we want to run on each worksheet.

Dont forget that, at the end of the loop we still need something:

Next a

This tells the For loop that it should increment the value of the a variable by 1 each time the loop runs through a cycle or goes through a sheet.  The loop will not work without this line of code at the end of it.

In the original example we also have a line of code within the For loop:

MsgBox ActiveWorkbook.Worksheets(a).Name

This line will output the name of each worksheet into a pop-up message box; it also illustrates how you can access the worksheets from within the loop.

To do anything with the sheets from within the loop, we need to access each sheet by its reference or index number.  Each sheet has an index number and it always starts at 1 and increments by 1 for the next sheet in the workbook.

This is why we create the a variable and set it equal to 1 in the For loop, because the first sheet in the workbook always has an index number of 1, and we want to use a as the index number to access the worksheets.

Each time the loop runs and a is incremented by one, this allows you to access the next sheet in the workbook.  This is why we needed to count how many sheets were in the workbook, so we would know when to tell the For loop to stop running because there were no more sheets.

So, we can access the worksheets from within the loop by using
ActiveWorkbook.Worksheets(index number)

or

Sheets(index number)

Remember that the variable a is being used as our index number in this case.

Using this method you can do anything you want with the corresponding worksheet.

And thats how you loop through all worksheets in a workbook in Excel!

Make sure to download the accompanying file for this tutorial so you can see the VBA/Macro code in action.

Similar Content on TeachExcel

Get the Name of a Worksheet in Macros VBA in Excel

Tutorial: How to get the name of a worksheet in Excel using VBA and Macros and also how to store tha…

Excel Input Form with Macros and VBA

Tutorial:
Forms Course
How to make a data entry form in Excel using VBA and Macros — this allows yo…

Get User Submitted Data from a Prompt in Excel using VBA Macros

Tutorial: How to prompt a user for their input in Excel.
There is a simple way to do this using VBA …

Find the Next Blank Row with VBA Macros in Excel

Tutorial:
Learn how to find the next empty cell in a range in Excel using VBA and Macros.  This me…

Loop Through an Array in Excel VBA Macros

Tutorial:
I’ll show you how to loop through an array in VBA and macros in Excel.  This is a fairly…

Copy Data or Formatting to Multiple Worksheets in Excel

Tutorial:
Quickly copy all or parts of a single worksheet — data, formatting, or both — to multiple…

Subscribe for Weekly Tutorials

BONUS: subscribe now to download our Top Tutorials Ebook!

Источник

четверг, 4 октября 2018 г.

Макрос для перебора всех листов в книге

 Sub WorksheetLoop()
         Dim WS_Count As Integer
         Dim I As Integer
         WS_Count = ActiveWorkbook.Worksheets.Count
         For I = 1 To WS_Count
            MsgBox ActiveWorkbook.Worksheets(I).Name
         Next I
      End Sub
 
 
 
 
Sub WorksheetLoop2()
         Dim Current As Worksheet
         For Each Current In Worksheets
            MsgBox Current.Name
         Next
      End Sub


Автор:

Владимир Усольцев




на

14:56






Ярлыки:
VBA

Комментариев нет:

Отправить комментарий

Источник
 

AmegaMSK

Пользователь

Сообщений: 41
Регистрация: 20.02.2013

#1

18.10.2013 23:53:55

Добрый вечер!
Подскажите, пожалуйста, почему мой макрос останавливается, не отработав все открытые книги?
Вроде цикл указала правильно, но из 10 открытых книг обрабатываются сначала 5, потом я запускаю макрос еще раз, он обрабатывает еще 4, и потом еще раз запуск макроса — и он обрабатывает последнюю книгу.
Что я сделала не так?
Прилагаю код:

Код 
Dim wb As Workbook
For Each wb In Workbooks
.......
.......
.......
Next
End Sub
 

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

А где перебор всех листов?
 

AmegaMSK

Пользователь

Сообщений: 41
Регистрация: 20.02.2013

Цель — перебор всех листов во всех открытых книгах.
Или лучше выложить весь макрос? (Он не очень большой)
 

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

Какое действие выполняется при выборе очередного листа ?
 

AmegaMSK

Пользователь

Сообщений: 41
Регистрация: 20.02.2013

#5

19.10.2013 00:05:55

Код 
Dim wb As Workbook
For Each wb In Workbooks
 
 For s = 1 To Worksheets.Count
 Worksheets(s).Activate
 On Error GoTo 0
 Range("IU1" ;)  = ActiveSheet.Name
 Next s
 Columns("IU:IV" ;) .EntireColumn.Hidden = True
 For s = 1 To Worksheets.Count
 Worksheets(s).Activate
 On Error GoTo 0
 Range("IV1" ;) .FormulaR1C1 = _
 "=IF.... ' тут очень длинная формула
 Next s
 Application.DisplayAlerts = False
 For i = Sheets.Count To 1 Step -1
 If Sheets(i).[IV1] = 7 Then Sheets(i).PrintOut From:=1, To:=1, Copies:=1, Collate:=True
 Next
 Application.DisplayAlerts = True
 For s = 1 To Worksheets.Count
 Worksheets(s).Activate
 On Error GoTo 0
 Range("O1" ;)  = ClearContens
 Next s
 ActiveWindow.Close False
Next

End Sub
 

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

А зачем столько циклов(кажется 4) по листам очередной книги?
Книга, где макрос, тоже открытая книга, вы ее тоже обрабатываете?
Columns(«IU:IV»).EntireColumn.Hidden = True это в каком листе вы скрываете столбцы?
 

AmegaMSK

Пользователь

Сообщений: 41
Регистрация: 20.02.2013

Макрос у меня не в «эта книга», а в «все открытые книги», поэтому нет, лишнее не обрабатывается.
Столбцы скрываю во всех листах книги, чтобы данные вписанные макросом (имя листа и формула рядом) не пошли на печать.
А с циклами — я не профессионал, я только учусь :)
 

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

#8

19.10.2013 00:47:46

Попробуйте так

Код 
Option Explicit
Sub AllSheets()
Dim wb As Workbook
Dim s As Integer
    For Each wb In Workbooks
        Application.DisplayAlerts = False
    For s = 1 To Worksheets.Count
        Worksheets(s).Activate
        On Error GoTo 0
            Range("IU1") = ActiveSheet.Name
                Range("IV1").FormulaR1C1 = _
                 "=IF.... ' тут очень длинная формула "
            Columns("IU:IV").EntireColumn.Hidden = True
 If Sheets(s).[IV1] = 7 Then Sheets(s).PrintOut From:=1, To:=1, Copies:=1, Collate:=True
            Range("O1").ClearContens
    Next s
        Application.DisplayAlerts = True
        ActiveWindow.Close False
Next
End Sub
 

AmegaMSK

Пользователь

Сообщений: 41
Регистрация: 20.02.2013

Обработал 7листов, потом 2 листа и потом еще 1 лист.
Почему-то останавливается  :(

Изменено: AmegaMSK — 19.10.2013 00:58:50
 

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

Попробуйте выполнить макрос в пошаговом режиме, те ли книги перебираются
все ли листы обрабатываются.
 

AmegaMSK

Пользователь

Сообщений: 41
Регистрация: 20.02.2013

Стоп! Я вас дезинформировала!
Я скопировала ваш код без первых двух строк, поспешила на радостях  :)
Полностью код не работает, пишет ошибку на этой строчке «Option Explicit»
Текст ошибки «invalid inside procedure»

Изменено: AmegaMSK — 19.10.2013 01:30:33
 

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

#12

19.10.2013 13:23:14

Цитата
Обработал 7листов, потом 2 листа и потом еще 1 лист.

Так листов или книг? Может у вас не хватает памяти, когда открыты все 10 книг?
Я, обычно, все книги помещаю в один каталог и обрабатываю их последовательно:
открываю первую книгу, делаю действия и закрываю книгу, затем открываю следующую.
Как ведет себя макрос, который записан во всех открытых книгах, я не знаю .
Option Explicit — это явное объявление переменных
 

ikki

Пользователь

Сообщений: 9709
Регистрация: 22.12.2012

логическая ошибка
надо писать wb.Worksheets.Count, wb.Worksheets(s).Activate и т.п.
иначе — подобные команды применяются всегда к активной книге

фрилансер Excel, VBA — контакты в профиле
«Совершенствоваться не обязательно. Выживание — дело добровольное.» Э.Деминг

 

AmegaMSK

Пользователь

Сообщений: 41
Регистрация: 20.02.2013

Kuzmich, книг, конечно, книг  :)  
ikki, заменила в макросе Worksheets.Count на wb.Worksheets.Count и Worksheets(s).Activate на wb.Worksheets(s).Activate по вашему совету, однако результат тот же — макрос останавливается, как и прежде.
 

ikki

Пользователь

Сообщений: 9709
Регистрация: 22.12.2012

#15

19.10.2013 14:15:10

не увидел ответа на

Цитата
Попробуйте выполнить макрос в пошаговом режиме, те ли книги перебираются
все ли листы обрабатываются.

фрилансер Excel, VBA — контакты в профиле
«Совершенствоваться не обязательно. Выживание — дело добровольное.» Э.Деминг

 

AmegaMSK

Пользователь

Сообщений: 41
Регистрация: 20.02.2013

Попробовала, обрабатываются ВСЕ листы в открытых книгах (Именно каждый лист, как и было задумано!). Перед отправкой на печать тоже обрабатывается каждый лист. Обработанные книги закрываются без сохранения. Но макрос останавливается, приходится его еще раз запускать, далее все по тому же сценарию.
Т. е. все правильно работает, но с остановками.
 

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

#17

19.10.2013 14:56:11

Цитата
Обработанные книги закрываются без сохранения.

А где в коде макроса книги закрываются?
 

AmegaMSK

Пользователь

Сообщений: 41
Регистрация: 20.02.2013

Я так понимаю, что вот тут
       ActiveWindow.Close False
 

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

Не знаю ActiveWorkbook.Close False и ActiveWindow.Close False это одно и то же?
 

AmegaMSK

Пользователь

Сообщений: 41
Регистрация: 20.02.2013

Не знаю, так рекордер записал.
Я заменила на ActiveWorkbook.Close False, но ничего не изменилось.
 

ikki

Пользователь

Сообщений: 9709
Регистрация: 22.12.2012

#21

19.10.2013 15:34:39

Цитата
ActiveWorkbook.Close False и ActiveWindow.Close False это одно и то же?

не всегда.
у одной книги может быть открыто более одного окна.
в этом случае ActiveWindow.Close приведёт к закрытию одного из окон (активного), но не файла.

фрилансер Excel, VBA — контакты в профиле
«Совершенствоваться не обязательно. Выживание — дело добровольное.» Э.Деминг

 

tigor

Пользователь

Сообщений: 17
Регистрация: 01.01.1970

Так чем сердце успокоилось?

У меня похожая задача — нужно, чтоб макрос выполнялся во всех листах, во всех открытых книгах, кроме файла с макросом (thisworkbook???)
Предварительный план такой — Пересчитать открытые книги, организовать цикл через IF. Я хз…
 

Mershik

Пользователь

Сообщений: 8277
Регистрация: 03.12.2015

#23

28.02.2021 17:26:50

Цитата
tigor написал:
Преварительный план такой

создать свою тему, описать задачу  показать желаемый результат

Не бойтесь совершенства. Вам его не достичь.

 

tigor

Пользователь

Сообщений: 17
Регистрация: 01.01.1970

#24

28.02.2021 17:36:29

Цитата
Mershik написал:
создать свою тему, описать задачу  показать желаемый результат

не хочу засорять форум копеечными темами. Может когда припрет… Спасибо.
 

Mershik

Пользователь

Сообщений: 8277
Регистрация: 03.12.2015

#25

28.02.2021 17:43:21

tigor, ну попробуйте так:

Код 
Sub mrshkei()
Dim wb As Workbook, sh As Worksheet
For Each wb In Workbooks
    If Not wb Is ThisWorkbook And wb.Name <> "PERSONAL.XLSB" Then
        With Workbooks(wb.Name)
            For i = 1 To .Worksheets.Count
                'действие макроса с листом
            Next i
        End With
    End If
Next
End Sub

Не бойтесь совершенства. Вам его не достичь.

 

tigor

Пользователь

Сообщений: 17
Регистрация: 01.01.1970

Mershik, Спасибо большое, но возникла такая же проблема проблема, что и у автора ветки. После прохода 3-4 файлов (всего их 13) эксель вылетает.  Некоторые файлы получились с ошибками.

Прийдется вызывать файлы по очереди через DIR

Cпасибо вам большое за помощь.

З.Ы. Может есть какой-то  tmp, который переполняется? И его надо почистить?  

Изменено: tigor — 01.03.2021 02:11:22
 

Евгений Смирнов

Пользователь

Сообщений: 539
Регистрация: 18.02.2021

#27

01.03.2021 09:28:21

Что касается сообщения 5 то наверно так будет работать

Код 
Sub fdgh()
Dim wb As Workbook
For Each wb In Workbooks
 For s = 1 To Worksheets.Count
 Worksheets(s).Activate
 On Error GoTo 0
 Range("IU1") = ActiveSheet.Name
 Next s
 Columns("IU:IV").EntireColumn.Hidden = True
 For s = 1 To Worksheets.Count
 Worksheets(s).Activate
 On Error GoTo 0
 Range("IV1").FormulaR1C1 = _
 "=IF.... ' тут очень длинная формула"
 Next s
 Application.DisplayAlerts = False
 For i = Sheets.Count To 1 Step -1
 If [IV1] = 7 Then Sheets(i).PrintOut From:=1, To:=1, Copies:=1, Collate:=True
 Next
 Application.DisplayAlerts = True
 For s = 1 To Worksheets.Count
 Worksheets(s).Activate
 On Error GoTo 0
 Range("O1").ClearContens
 Next s
'Следующий оператор надо отсюда убрать
'Тут закрывать нельзя коллекция книг уменьшается поэтому до конца не доходит
 ActiveWindow.Close False
Next wb
End Sub
 

tigor

Пользователь

Сообщений: 17
Регистрация: 01.01.1970

Евгений Смирнов, спасибо, попробуем
 

tigor

Пользователь

Сообщений: 17
Регистрация: 01.01.1970

Заметил причину сбоев — в некоторых книгах были скрытые листы. Возможно, у автора поста было тоже самое, на этих книгах макрос и затыкался.

Позже выложу файл примера с макросом. Может кому и ссгодится.
 

New

Пользователь

Сообщений: 4581
Регистрация: 06.01.2013

#30

02.03.2021 14:11:34

tigor, просто добавьте проверку на скрытый лист

Код 
Sub mrshkei()
Dim wb As Workbook, sh As Worksheet

    For Each wb In Workbooks 'по всем открытым книгам/файлам
        If Not wb Is ThisWorkbook And wb.Name <> "PERSONAL.XLSB" Then 'если не книга с макросом и не Личная книга макросов
        'If wb.Name <> "PERSONAL.XLSB" Then 'если не надо исключать книгу с этим макросом
            With Workbooks(wb.Name)
                For Each sh In wb.Worksheets 'по всем листам в книге
                    If sh.Visible = True Then 'если лист не скрытый
                        MsgBox sh.Name 'что-то делаем с этим листом
                    End If
                Next sh
            End With
        End If
    Next wb
End Sub

Изменено: New — 02.03.2021 14:25:30
Источник

Понравилась статья? Поделить с друзьями:
  • Excel vba парсинг строки
  • Excel vba парсинг сайта
  • Excel vba парсер xml
  • Excel vba пароль на проект
  • Excel vba пароль для листа