如何在循环中滚动到每张纸的顶部

Question

我正在运行一个宏来循环浏览 7 个工作表。但是，一旦保存并转到第一个工作表，我就在表格的底部。

我尝试了不同的行来尝试滚动回循环内所有工作表的顶部，但似乎没有任何工作。

我试过了：

ActiveWindow.ScrollRow = 1

Application.Goto Reference:=Range("A1"), Scroll:=True

我知道你不应该使用 select，但我也尝试过：.Range("A1").Select

有什么想法吗？

Sub BrandRank_Pints_IceCream()

    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim Tbl     As ListObject
    Dim Rng     As Range                ' range in which to set the table
    Dim Rl      As Long                 ' last row
    Dim Cl      As Long                 ' last column
    
For Each Ws In ActiveWorkbook.Worksheets
    With Ws
        If .Index <> 1 Then

'Combine Bear and Dog Data & Delete Rows
    'Find the last used row in Column A
        Dim RngA As Long
            RngA = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row
    
    'Add Text in Column A, B, and C
        .Cells(RngA, "A").Value = "Blue"
        .Cells(RngA, "B").Value = "Red"
        .Cells(RngA, "C").Value = "TEST"

    'Combine Data containing 'Bear*' and 'Dog*' data
        Dim RngTest As Range
            Set RngTest = .Range("C:C").Find("Test", LookIn:=xlValues, Lookat:=xlWhole)

        RngTest.Offset(0, 1).Formula = "=sum(sumifs(D:D, C:C, {""Bear*"" , ""Dog*""}))"
        RngTest.Offset(0, 2).Formula = "=sum(sumifs(E:E, C:C, {""Bear*"" , ""Dog*""}))"
        RngTest.Offset(0, 3).Formula = "=sum(sumifs(F:F, C:C, {""Bear*"" , ""Dog*""}))"
        RngTest.Offset(0, 5).Formula = "=sum(sumifs(H:H, C:C, {""Bear*"" , ""Dog*""}))"
        RngTest.Offset(0, 6).Formula = "=sum(sumifs(I:I, C:C, {""Bear*"" , ""Dog*""}))"
        RngTest.Offset(0, 7).Formula = "=sum(sumifs(J:J, C:C, {""Bear*"" , ""Dog*""}))"
        RngTest.Offset(0, 8).Formula = "=sum(sumifs(L:L, C:C, {""Bear*"" , ""Dog*""}))"
        RngTest.Offset(0, 10).Formula = "=sum(sumifs(M:M, C:C, {""Bear*"" , ""Dog*""}))"
        
            RngTest.EntireRow.Copy
                RngTest.EntireRow.PasteSpecial xlPasteValues
                
        Application.CutCopyMode = False
        
'Filter "Bear*" and "Dog*", and Delete Rows
    Dim DataLastRow As Long
        DataLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    
    'Apply Filter
         .Range("A3:M3").AutoFilter Field:=3, Criteria1:=Array("Bear*"" , ""Dog"), Operator:=xlFilterValues

    'Delete Rows
        .Range("A4:M" & DataLastRow).EntireRow.Delete
         
    'Clear Filter
        .AutoFilter.ShowAllData
       .Cells.AutoFilter
            
    'Replace Test for Bear/Dog
        RngTest.Replace "Test", "BEAR/DOG"
            
            
'Insert Table with the Data starting in Column A3:M
            ' find the last used row in column A
            Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
            ' find the last used column in row 3
            Cl = .Cells(3, .Columns.Count).End(xlToLeft).Column
            ' set the range for the table
            Set Rng = .Range(.Cells(3, "A"), .Cells(Rl, Cl))
            ' convert the range to a table
            Set Tbl = .ListObjects.Add(xlSrcRange, Rng, , xlYes)

'Remove / Change Table Format
    With Tbl
        .Name = .Name & "_Table"
        .Range.ClearFormats
        .TableStyle = "TableStyleMedium10"
        .Range.Font.Bold = True
        .Range.Font.Size = 16

'Apply a filter to $ Share for all Brands (Largest to Smallest)
        .AutoFilter.Sort.SortFields.clear
        .AutoFilter.Sort.SortFields.Add2 Key:=Range("D3"), SortOn:=xlSortOnValues, Order:=xlDescending
        .AutoFilter.ApplyFilter
        .ShowAutoFilterDropDown = False
    End With
 
'Update $ - % Chg Formula
    .Range("G4").Formula = "=IFERROR((F4/(F4-H4))-1,"""")"
    .Range("G4").NumberFormat = "0.0%"
    .Range("G4").AutoFill Destination:=.Range("G4:G" & DataLastRow)
      
'Update Units - % Chg Formula
    .Range("L4").Formula = "=IFERROR((K4/(K4-M4))-1,"""")"
    .Range("L4").NumberFormat = "0.0%"
    .Range("L4").AutoFill Destination:=.Range("L4:L" & DataLastRow)
    
'Insert 3 Rows
    .Rows("20:22").Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove
    .Range("C20").Value = "ALL OTHER"
    .Range("C21").Value = "GRAND TOTAL"
    
'Add Formulas to ALL OTHER
    Dim aOther As Range
            Set aOther = .Range("C:C").Find("All Other", LookIn:=xlValues, Lookat:=xlWhole)
        
            aOther.Offset(0, 1).Formula = "=SUM(" & aOther.Offset(3, 1).Address & ":" & .Cells(DataLastRow, 4).Address & ")"
            aOther.Offset(0, 2).Formula = "=SUM(" & aOther.Offset(3, 2).Address & ":" & .Cells(DataLastRow, 5).Address & ")"
            aOther.Offset(0, 3).Formula = "=SUM(" & aOther.Offset(3, 3).Address & ":" & .Cells(DataLastRow, 6).Address & ")"
            aOther.Offset(0, 5).Formula = "=SUM(" & aOther.Offset(3, 5).Address & ":" & .Cells(DataLastRow, 8).Address & ")"
            aOther.Offset(0, 6).Formula = "=SUM(" & aOther.Offset(3, 6).Address & ":" & .Cells(DataLastRow, 9).Address & ")"
            aOther.Offset(0, 7).Formula = "=SUM(" & aOther.Offset(3, 7).Address & ":" & .Cells(DataLastRow, 10).Address & ")"
            aOther.Offset(0, 8).Formula = "=SUM(" & aOther.Offset(3, 8).Address & ":" & .Cells(DataLastRow, 11).Address & ")"
            aOther.Offset(0, 10).Formula = "=SUM(" & aOther.Offset(3, 10).Address & ":" & .Cells(DataLastRow, 13).Address & ")"

'Add Formulas to Grand Total
    .Range("F21").Formula = "=Sum(F4:F20)"
    .Range("H21").Formula = "=Sum(H4:H20)"
    .Range("K21").Formula = "=Sum(K4:K20)"
    .Range("M21").Formula = "=Sum(M4:M20)"
    
'Update Column Format
    .Columns("D").NumberFormat = "0.0"
    .Columns("E").NumberFormat = "0.0"
    .Columns("F").NumberFormat = "$#,##0"
    .Columns("H").NumberFormat = "$#,##0"
    .Columns("I").NumberFormat = "0.0"
    .Columns("J").NumberFormat = "0.0"
    .Columns("K").NumberFormat = "#,##0"
    .Columns("M").NumberFormat = "#,##0"

    
    .Range("D3").Value = "$ SHARE"
    .Range("E3").Value = "$ SHARE CHG"
    .Range("F3").Value = "$"
    .Range("G3").Value = "$ - % CHG"
    .Range("H3").Value = "$ - ABS CHG"
    .Range("I3").Value = "UNITS SHARE"
    .Range("J3").Value = "UNITS SHARE CHG"
    .Range("K3").Value = "UNITS"
    .Range("L3").Value = "UNITS - % CHG"
    .Range("M3").Value = "UNITS - ABS CHG"
    

    .Columns("D:M").EntireColumn.HorizontalAlignment = xlCenter
    .Columns("D:M").EntireColumn.AutoFit
    
'Highlight Grand Total Row
    Dim gTotal As Range
        Set gTotal = .Range("C:C").Find("Grand Total", LookIn:=xlValues, Lookat:=xlWhole)
        
        With gTotal
            .EntireRow.Interior.ThemeColor = xlThemeColorAccent2
            .EntireRow.Font.ThemeColor = xlThemeColorDark1
        End With

'Highlight BRAND Row
    Dim Brand As Range
        Set Brand = .Range("C:C").Find("BRAND", LookIn:=xlValues, Lookat:=xlWhole)
            
            With Brand
                Brand.Offset(0, -2).Resize(1, 13).BorderAround , xlThick, -11489280
            End With

    Application.Goto Reference:=Range("A1"), Scroll:=True

        End If
    End With
Next Ws

'Save File
Application.DisplayAlerts = False
    Dim TemplatePath As String
        TemplatePath = ""
        ActiveWorkbook.SaveAs Filename:=TemplatePath & "BrandRank - Template" & ".xlsm", FileFormat:=52
Application.DisplayAlerts = True
    
End Sub

Answer 1

请尝试Ws.Activate: Ws.Range("A1").Select...为什么要滚动？