重新运行代码时出错

首先，我直接从Excel工作簿中运行代码时出错。 它会导致下面提到的错误信息

我们查看了所选数据旁边的所有数据，但没有看到为您填写数值的模式。 要使用Flash Fill，请input您希望看到的输出的几个示例，将活动单元格保留在要填写的列中，然后再次单击Flash Fillbutton

但是，如果在开发人员选项卡下从VBA窗口播放，则可以运行代码。 但是，在popup错误消息1004之前仅限于运行1次，并且在再次播放时也编码错误。

请帮忙。 从来没有教过或学过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