Цикл для каждого листа.

[Richard123]

Добрый день!

Есть вопрос! Как правильно написать макрос в котором выполнялась бы вот такие процедуры для каждого листа?

Sub Capsula_Rows_Var_and_Head()

Dim RowVar As Long
RR = 11

For RowVar = Cells(ROWS.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(RowVar, 1) <> Cells(RowVar - 1, 1) Then ROWS(RowVar).Resize(RR).Insert
Next

For RowVar = Cells(ROWS.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(RowVar, 1) <> Cells(RowVar - 1, 1) Then
If Cells(RowVar - 1, 1) = 0 Then
If Cells(RowVar, 1) = Cells(RowVar + 1, 1) Then


    Range("1:1").Copy ROWS(RowVar - 1)

End If
End If
End If
Next

ROWS("1:11").Delete Shift:=xlUp

Я знаю что есть For Each sh In Sheets, но не умею пользоваться. Когда просто подставляю то получает что внутренний цикл выполняется столько раз сколько листов в книге...

[Александр 33]

Может быть это :

Sub Capsula_Rows_Var_and_Head()
Dim J As Variant
Dim RowVar As Long
RR = 11
For J = 1 To Sheets.Count
Sheets(J).Activate
For RowVar = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(RowVar, 1) <> Cells(RowVar - 1, 1) Then Rows(RowVar).Resize(RR).Insert
Next
For RowVar = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(RowVar, 1) <> Cells(RowVar - 1, 1) Then
If Cells(RowVar - 1, 1) = 0 Then
If Cells(RowVar, 1) = Cells(RowVar + 1, 1) Then
Range("1:1").Copy Rows(RowVar - 1)
End If
End If
End If
Next
Rows("1:11").Delete Shift:=xlUp
Next J
End Sub

[EducatedFool]

Sub test()
    Application.ScreenUpdating = False    ' отключаем обновление экрана
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets    ' перебираем все листы
        sh.Activate    ' активируем лист
        Capsula_Rows_Var_and_Head    ' запускаем ваш макрос для очередного листа
    Next sh
End Sub

' ниже пишете свой макрос

[Richard123]

Сообщение от Александр 33

Может быть это :

Sub Capsula_Rows_Var_and_Head()
Dim J As Variant
Dim RowVar As Long
RR = 11
For J = 1 To Sheets.Count
Sheets(J).Activate
For RowVar = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(RowVar, 1) <> Cells(RowVar - 1, 1) Then Rows(RowVar).Resize(RR).Insert
Next
For RowVar = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(RowVar, 1) <> Cells(RowVar - 1, 1) Then
If Cells(RowVar - 1, 1) = 0 Then
If Cells(RowVar, 1) = Cells(RowVar + 1, 1) Then
Range("1:1").Copy Rows(RowVar - 1)
End If
End If
End If
Next
Rows("1:11").Delete Shift:=xlUp
Next J
End Sub

Работает. Большое Спасибо.



Код:

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

Sub test()
    Application.ScreenUpdating = False    ' отключаем обновление экрана
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets    ' перебираем все листы
        sh.Activate    ' активируем лист
        Capsula_Rows_Var_and_Head    ' запускаем ваш макрос для очередного листа
    Next sh
End Sub

' ниже пишете свой макрос

не работает. Точнее если запускать из VBA обратывает 1-ый лист, а остальные не трогает. =((