Цикл макроса через каждый лист

Question

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

Sub Cleaner() 
Dim wb As Workbook 
Dim sht As Worksheet 
Dim savedel As Boolean 
Dim cellcounter As Integer 
Dim country As String 

country = InputBox("Enter Country to Save") 
If country = "" Then Exit Sub 

cellcounter = 1 

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

For Each wb In Application.Workbooks 
    If wb.Name <> "PERSONAL.xlsb" Then 
    For Each sht In wb.Worksheets 

    Do Until cellcounter > Selection.SpecialCells(xlCellTypeLastCell).Row 

    'Ignore deletion of any spacer rows 
    If IsEmpty(Range("D" & cellcounter)) = True And IsEmpty(Range("E" & cellcounter)) = True Then 
     savedel = 1 

     'Ignore heading rows 
     ElseIf Len(Range("F" & cellcounter)) > 0 And IsNumeric(Left(Range("F" & cellcounter), 1)) = False Then 
      savedel = 1 

     'Ignore deletion of the country sought 
     ElseIf Range("B" & cellcounter).Value = country Then 
      savedel = 1 

     'Flag non-country for deletion 
     ElseIf Range("B" & cellcounter).Value <> country And IsEmpty(Range("B" & cellcounter).Value) = False Then 
      savedel = 0 
    End If 

    'If flagged, delete row 
    If savedel = 0 Then 
     Rows(cellcounter).Delete 
     cellcounter = cellcounter - 1 
    End If 

     cellcounter = cellcounter + 1 

    Loop 

Next sht 
End If 
Next wb 

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 

End Sub 

Answer 1

Я думаю, вам нужно переместить вас cellcounter Инициализация.

В вашей петле Selection.SpecialCells(xlCellTypeLastCell).Row всегда ссылается на один и тот же выбор, даже перемещаясь от листа к листу. Вероятно, вам также придется использовать sht.Cells.SpecialCells(xlCellTypeLastCell).Row.

Вы также должны заменить все свои Range на что-то относительно вашего текущего листа/выбора sht.Range.

... 
If country = "" Then Exit Sub 

' Move cellcounter initialization from here... 
'cellcounter = 1 

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

For Each wb In Application.Workbooks 
    If wb.Name <> "PERSONAL.xlsb" Then 
     For Each sht In wb.Worksheets 

      ' To here: 
      cellcounter = 1 

      Do Until cellcounter > sht.Cells.SpecialCells(xlCellTypeLastCell).Row 

      'Ignore deletion of any spacer rows 
      If IsEmpty(sht.Range("D" & cellcounter)) = True _ 
      And IsEmpty(sht.Range("E" & cellcounter)) = True Then 
       savedel = 1 

      'Ignore heading rows 
      ElseIf Len(sht.Range("F" & cellcounter)) > 0 And _ 
      IsNumeric(Left(sht.Range("F" & cellcounter), 1)) = False Then 
       savedel = 1 

      'Ignore deletion of the country sought 
      ElseIf sht.Range("B" & cellcounter).Value = country Then 
       savedel = 1 

      'Flag non-country for deletion 
      ElseIf sht.Range("B" & cellcounter).Value <> country _ 
      And IsEmpty(sht.Range("B" & cellcounter).Value) = False Then 
       savedel = 0 

      End If 
...