vba - 两年前的宏突然出现运行时错误 '9'

Question

我遇到了一个宏问题，我已经使用了几个月，几乎没有什么问题。该宏旨在重新格式化 Excel 报表并将其插入到 Excel 中的不同工作簿中。今天，我不断遇到这样的消息:

runtime error '9': subscript out of range

当我选择“调试”时，它会突出显示这行代码:

    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear

我不是编码员。我使用宏按钮来复制我所做的事情以缩短任务，但是除了将错误和突出显示的代码复制并粘贴到搜索引擎中以查看其他人可能尝试过的操作之外，我还没有足够的悟性来排除逻辑故障。该代码一直有效，我没有做任何不同的事情，但今天它抛出了“9”错误。我尝试过重命名工作表以匹配代码，所以基本上是“Sheet1”。我复制了上个月的工作表，删除了旧数据，并尝试运行宏。我什至按照谷歌发现的建议对代码进行了调整，但我只是创建了一个“1004”错误，因为除了隐含的方向之外，我并不完全理解 xlTop 与 xlDown 的逻辑。那不起作用，所以我回到了第一个地方。

这是我总共的宏代码。这很简单。

    Sub UserStats()
    '
    ' UserStats Macro
    '
        Application.ScreenUpdating = False 'Doesn't show the macro 
        run on the screen, speeds up program
    '
   Cells.Select
   With Selection
    .VerticalAlignment = xlTop
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
   End With
   Columns("A:A").Select
   Selection.Delete Shift:=xlToLeft
   Columns("B:C").Select
   Selection.Delete Shift:=xlToLeft
   Columns("C:D").Select
   Selection.Delete Shift:=xlToLeft
   Columns("D:I").Select
   Selection.Delete Shift:=xlToLeft
   Rows("1:7").Select
   Selection.Delete Shift:=xlUp
   Columns("A:D").Select

     ' SortUserStats Macro
      ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
      ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
          SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
          xlSortTextAsNumbers
      With ActiveWorkbook.Worksheets("Sheet1").Sort
          .SetRange Range("A:D")
          .Header = xlNo
          .MatchCase = False
          .Orientation = xlTopToBottom
          .SortMethod = xlPinYin
          .Apply
End With

  ' CopyUserStats Macro
    Cells.Select
    Selection.RowHeight = 12
    Range("A2:D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    Workbooks("User Stats Prep.xlsx").Worksheets(1).Activate
    Cells(Range("A1").End(xlDown).Row + 1, 1).Select
    Selection.Insert Shift:=xlDown
    Cells.Select
    Selection.RowHeight = 12
    Cells(Range("A1").End(xlDown).Row + 1, 1).Select

    Application.CutCopyMode = False

    ActiveWorkbook.Close SaveChanges:=True
    ActiveWorkbook.Close SaveChanges:=False

End Sub

我很感激任何建议，否则我将逐行复制和粘贴样式添加新数据。

Answer 1

我尝试重写它，以便它没有宏记录器通常创建的多余内容。如果这不起作用或者它的工作方式与以前不同，请准确描述问题所在/错误

Sub UserStats()
    '
    ' UserStats Macro
    '

    Application.ScreenUpdating = False  'hides screen, speeds up program

    With ActiveWorkbook.Sheets(1)

        'format all sheet1 cells
        With .Cells
            .VerticalAlignment = xlTop
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
            .RowHeight = 12
        End With

        'delete A:D, D:I, and 1:7
        .Columns("A:D").Delete Shift:=xlToLeft
        .Columns("D:I").Delete Shift:=xlToLeft
        .Rows("1:7").Delete Shift:=xlUp

        'Sort UserStats
        With .Columns("A:D").Sort

            .SortFields.Clear
            .SortFields.Add _
                key:=Range("A1"), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                DataOption:=xlSortTextAsNumbers

            .SetRange Range("A:D")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply

        End With

        'Copy UserStats
        ActiveWorkbook.Sheets(1).Range(Range("A2:D2"), Range("A2:D2").End(xlDown)).copy
    End With

    With Workbooks("User Stats Prep.xlsx").Worksheets(1)
        .Cells.RowHeight = 12
        .Cells(Range("A1").End(xlDown).row + 1, 1).Insert Shift:=xlDown
    End With

    Workbooks("User Stats Prep.xlsx").Close SaveChanges:=True

    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With

End Sub