нужна помощь в исправлении оператора with внутри подпрограммы, вложенной в цикл

Question

ниже - макрос, над которым я работал, который обновляет набор значений во всех «числовых» листах (т.е. листах с числовыми именами), используя данные из мастер-листа с именем «BW TB».

По какой-то причине подпрограмма «ClearContents» очищает данные во всех числовых листах, но также и в основной таблице (и, таким образом, ничего не копируется с использованием двух других подпрограмм), и я не могу понять, почему!Полный код ниже;пожалуйста, посмотрите:

Option Explicit

Dim BW As String, FirstRow As Integer, LastRow As Integer, ColNo As Integer, i As Integer

Sub Refresh_Data()

    Application.CutCopyMode = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    'Defines the range of rows and columns in the refreshed BW query
    BW = "BW TB"
    Worksheets(BW).Activate
    Range("A1").Activate

    Dim MyCell As Range
    Set MyCell = Cells.Find(What:="Overall Result", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
    True, SearchFormat:=False)
    FirstRow = MyCell.End(xlUp).Row + 1
    LastRow = MyCell.Row - 1
    ColNo = MyCell.Column

    'loop to update numeric sheets
    For i = 1 To Sheets.Count
    If IsNumeric(Sheets(i).Name) Then
        Call Clearcontents
        Call PasteGLCodes
        Call PasteTBValues
    End If
    Next

    Call CheckTotals

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub


Private Sub Clearcontents()

'clears the contents of the sheet of Row 6 to 1000 for every column containing data in Row 6
Dim ColRange As Integer
With Worksheets(i)
    ColRange = .Cells(6, .Columns.Count).End(xlToLeft).Column
    .Range("A6", .Cells(1000, ColRange)).Clearcontents
End With    
End Sub

Private Sub PasteGLCodes()

'Pastes the range of GL codes from ColumnA
With Worksheets(BW)
    Range(.Cells(FirstRow, ColNo), .Cells(LastRow, ColNo)).Copy
End With
Worksheets(i).Range("A5").PasteSpecial xlPasteValues

End Sub

Private Sub PasteTBValues()

'Copies the formula from top row and drags to the last row
Range("B5:L5").Copy
Range("B5:L5", Range("B5:L5").Offset(LastRow - FirstRow, 0)).PasteSpecial xlPasteFormulas

'Recalculates the formulae
ActiveSheet.Calculate

'Pastes the values from the second row down to the last row
Range("B6:L6", Range("B6:L6").Offset(LastRow - FirstRow, 0)).Copy
Range("B6").PasteSpecial xlPasteValues

End Sub

Private Sub CheckTotals()

Application.Goto Worksheets("Control sheet").Range("AU114"), True
MsgBox "Update complete - check control totals"

End Sub

Если я заменим ClearContents на:

Private Sub Clearcontents()

    Sheets(i).Activate
    Range("A6").EntireRow.Select
    Range(Selection, Selection.Offset(1000, 0)).Clearcontents

End Sub

, он будет работать нормально, но это явно менее чистое решение.

Как всегда, любая помощь высоко ценится!

Answer 1

Попробуйте изменить

.Range("A6", .Cells(1000, ColRange)).Clearcontents

на

.Range(.Range("A6"), .Cells(1000, ColRange)).Clearcontents

в подпункте Clearcontents.

РЕДАКТИРОВАТЬ Я вижу вашу проблему: ни Clearcontents, ни PasteGLCodes не активируют i-й лист, поэтому ваш вызов на PasteTBValues всегда будет действовать на листе, который вы активировали в начале своего пробега ("BWТБ ").Вам нужно изменить последний саб, чтобы он работал на i-м листе ...

Answer 2

Если у вас есть какие-либо диаграммы в книге, вы будете ссылаться на разные листы, как в методе Refresh_Data, который вы используете Sheets, так и в методе ClearContents, который вы используете WorkSheets

Коллекция Sheets содержит листы и листы диаграмм.

Коллекция Worksheets содержит только листы.

Итак, используйте Sheets в методе ClearContents.