錯誤重新運行代碼

Question

首先，我直接從Excel工作簿中運行代碼時出錯。它會導致下面提到的錯誤消息

我們查看了所選數據旁邊的所有數據，但沒有看到爲您填寫值的模式。要使用Flash Fill，請輸入您希望看到的輸出的幾個示例，將活動單元格保留在要填寫的列中，然後再次單擊Flash Fill按鈕。

但是，我可以運行代碼是否在開發人員選項卡下從VBA窗口播放。但是，僅限於運行1次纔會彈出錯誤消息1004，並且在再次播放時也會出現代碼錯誤。

請幫忙。從來沒有教過或學過VBA。下面的代碼是在網上研究和試用&錯誤的混搭。

Sub Graph() 
' 
' Graph Macro 
' 
' Keyboard Shortcut: Ctrl+e 
' 
'Select values in a column from specified workbook and sheet 
Dim LR As Long, cell As Range, rng As Range 

Windows("Area3-LG").Activate 
With Sheets("Graph data") 
    LR = .Range("B" & Rows.Count).End(xlUp).Row 
    For Each cell In .Range("B4:B" & LR) 
     If cell.Value <> "" Then 
      If rng Is Nothing Then 
       Set rng = cell 
      Else 
       Set rng = Union(rng, cell) 
      End If 
     End If 
    Next cell 
    'Error with rng.select when Macro is runned again 
    rng.Select  
End With 
Selection.Copy 

'Open next workbook 
Windows("InstData_TEMS_Existing").Activate 
'Open Sheet L 
Sheets("L").Select 
'Select empty field fromn column AA 
Range("AA" & Rows.Count).End(xlUp).Offset(1).Select 
'paste selection to empty field 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
'Go back to previous workbook & delete column 
Windows("Area3-LG").Activate 
Sheets("Graph data").Select 
Columns("B:B").Select 
Application.CutCopyMode = False 
Selection.Delete Shift:=xlToLeft 
Sheets("Graph Data").Select 

End Sub 

在此先感謝（：

Answer 1

嘗試下面的代碼，沒有所有的不必要Select，Activate和Selection：

Sub Graph() 
' 
' Graph Macro 
' 
' Keyboard Shortcut: Ctrl+e 
' 
'Select values in a column from specified workbook and sheet 
Dim LR As Long, cell As Range, rng As Range 

With Workbooks("Area3-LG").Sheets("Graph data") 
    LR = .Range("B" & .Rows.Count).End(xlUp).Row 
    For Each cell In .Range("B4:B" & LR) 
     If cell.Value <> "" Then 
      If rng Is Nothing Then 
       Set rng = cell 
      Else 
       Set rng = Union(rng, cell) 
      End If 
     End If 
    Next cell 
End With 
rng.Copy ' copy the union range (no need to select it first) 

' paste without all the selecting 
With Windows("InstData_TEMS_Existing").Sheets("L") 
    ' Paste (without select) un the next empty cell fromn column AA 
    .Range("AA" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ 
          SkipBlanks:=False, Transpose:=False 
End With 

Application.CutCopyMode = False 

'Go back to previous workbook & delete column 
Workbooks("Area3-LG").Sheets("Graph data").Columns("B:B").Delete Shift:=xlToLeft 

End Sub