無法激活工作表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更多的方法從依靠選擇越來越遠，並激活，以實現自己的目標。