Перебирая все листы выпуска

Question

У меня есть длинный макрос, в конце которого есть следующее:

        On Error Resume Next

    For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
        Do
        If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
            Cells(iRow + 1, iCol).EntireRow.Insert Shift:=xlDown
            iRow = iRow + 2
        Else
            iRow = iRow + 1
        End If
        Loop While Not Cells(iRow, iCol).Text = ""

        ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).ClearFormats

    Next ws

Это ДОЛЖНО добавить пустую строку при изменении в столбце B (для разделения групп данных), а затем удалить форматирование в пустой строке.

Похоже, что этот цикл не проходит правильно по всем рабочим листам, поскольку только изменение первого листа включает пустую строку после изменения в столбце B. Это также очень медленно.

Я надеялся, что смогу получить некоторую помощь в этом, и, возможно, лучшее разрешение, которое будет быстрее?

Заранее благодарю за помощь.

Answer 1

Как прокомментировал jsheeran, вы должны инициализировать iRow на каждом новом листе, который вы зацикливаете

Один из способов сделать это - выполнить цикл в обратном направлении от последней непустой строки ячейки в столбце iCol ко второй, что также упрощает код:

For Each ws In ActiveWorkbook.Worksheets
    With ws
        For iRow = .Cells(.Rows.Count, iCol).End(xlUp) To 2 Step - 1
            If .Cells(iRow - 1, iCol) <> .Cells(iRow, iCol) Then .Cells(iRow, iCol).EntireRow.Insert Shift:=xlDown
        Next
        On Error Resume Next
        .UsedRange.SpecialCells(xlCellTypeBlanks).ClearFormats
        On Error GoTo 0
    End With
Next

Answer 2

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

On Error Resume Next

For Each ws In ThisWorkbook.Worksheets
    With ws
        Do
            If .Cells(iRow + 1, iCol) <> .Cells(iRow, iCol) Then
                .Cells(iRow + 1, iCol).EntireRow.Insert Shift:=xlDown
                iRow = iRow + 2
            Else
                iRow = iRow + 1
            End If
        Loop While Not .Cells(iRow, iCol).Text = ""
        .UsedRange.SpecialCells(xlCellTypeBlanks).ClearFormats
    End With
Next ws