无法激活工作表VBA

Question

我是新来的编码，我似乎无法解决这个问题。我正在尝试将一个工作表中的一些范围复制并粘贴到另一个工作表中。当这样做的时候，当代码尝试激活新工作表时，我会继续收到错误消息提示。该守则如下。尝试在复制并粘贴范围之前激活“摘要”工作表时发生此错误。

Sub nxt() 
LR = Cells(Rows.Count, "A").End(xlUp).Row 
Last = Cells(Rows.Count, "D").End(xlUp).Row 
clryellow = RGB(256, 256, 0) 


ThisWorkbook.Sheets("Rankings").Select 
Sheets("Rankings").Select 
ActiveSheet.Range("A1:H1").Select 
Selection.AutoFilter 
    ActiveWorkbook.Worksheets("Rankings").AutoFilter.Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets("Rankings").AutoFilter.Sort.SortFields.Add Key:= _ 
    Range("H1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
    xlSortNormal 
With ActiveWorkbook.Worksheets("Rankings").AutoFilter.Sort 
    .Header = xlYes 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 

ThisWorkbook.Sheets("Summary").Activate 
Sheets("Summary").Select 
Sheets("Summary").Range("A8:A18").Value = Sheets("Rankings").Range("A2:A12").Value 
Sheets("Summary").Range("B8:B18").Value = Sheets("Rankings").Range("E2:E12").Value 
Sheets("Summary").Range("C8:C18").Value = Sheets("Rankings").Range("G2:G12").Value 
Sheets("Summary").Range("D8:D18").Value = Sheets("Rankings").Range("H2:H12").Value 

ActiveWorkbook.Sheets("Summary").Activate 
With ActiveSheet 
For x = Last To 8 Step -1 
    If (Cells(x, "D").Value) >= 6 Then 
     Cells(x, "A").EntireRow.Delete 
    ElseIf (Cells(x, 4).Value) < 6 Then 
     Cells(x, 1).Interior.Color = clryellow 
     Cells(x, 1).Font.Bold = True 
     Cells(x, 4).Interior.Color = clryellow 
     Cells(x, 4).Font.Bold = True 
    End If 
Next x 
End With 

For Each Worksheet In ActiveWorkbook.Worksheets 
ActiveSheet.Calculate 
Next Worksheet 

end sub 

Answer 1

您可以.Select一个或多个对象（表，电池等）到一个集合，但你只能.Activate其中之一。无论激活什么，始终都是选择的一部分，即使它们都是同一个单一对象。您不需要同时选择和。激活一个对象，除非您选择了多个对象，并要求其中一个是ActiveCell或ActiveSheet。

实质上，应使用.Select方法或.Activate method将工作表或范围对象引起用户的注意。没有必要选择或激活某些东西以便使用它（您的价值转移就是这样说的）。

这是一个简短的重写你的例程，避开依赖.Select和.Activate引用对象。

Sub summarizeRankings() 
    Dim lstA As Long, lstD As Long, clrYellow As Long, x As Long, ws As Worksheet 

    With ThisWorkbook 
     With .Worksheets("Rankings") 
      If .AutoFilterMode Then .AutoFilterMode = False 
      With .Cells(1, 1).CurrentRegion 
       With .Resize(.Rows.Count, 8) 
        .Cells.Sort Key1:=.Columns(8), Order1:=xlAscending, _ 
           Orientation:=xlTopToBottom, Header:=xlYes 
        .AutoFilter 
       End With 
      End With 
      Set ws = .Cells(1, 1).Parent 
     End With 
     With .Worksheets("Summary") 
      .Range("A8:A18").Value = ws.Range("A2:A12").Value 
      .Range("B8:B18").Value = ws.Range("E2:E12").Value 
      .Range("C8:C18").Value = ws.Range("G2:G12").Value 
      .Range("D8:D18").Value = ws.Range("H2:H12").Value 

      lstA = .Cells(Rows.Count, "A").End(xlUp).Row 
      lstD = .Cells(Rows.Count, "D").End(xlUp).Row 
      clrYellow = RGB(256, 256, 0) 

      For x = lstD To 8 Step -1 
       If (.Cells(x, "D").Value) >= 6 Then 
        .Cells(x, "A").EntireRow.Delete 
       ElseIf (.Cells(x, 4).Value) < 6 Then 
        .Cells(x, 1).Interior.Color = clrYellow 
        .Cells(x, 1).Font.Bold = True 
        .Cells(x, 4).Interior.Color = clrYellow 
        .Cells(x, 4).Font.Bold = True 
       End If 
      Next x 
      .Activate '<-last step brings the Summary worksheet to the front 
     End With 
    End With 

    Application.Calculate 

End Sub 

见How to avoid using Select in Excel VBA macros更多的方法从依靠选择越来越远，并激活，以实现自己的目标。