VBA 编译错误（1004 自动化错误）

Question

我正在尝试编写一个程序，该程序将从用户选择的网格和与之相邻的信息中获取信息并将它们发送到另一个工作簿。但是，每当我编译时，我都会收到错误 1004（自动化）。有人可以指出我在代码中哪里出错了吗？将不胜感激。

Sub CopyItemsByLocation()

Dim wbThis As Workbook
Dim wsThis As Worksheet
Dim wbTarget As Workbook
Dim wsTarget As Worksheet
Dim strName  As String
Dim i As Integer
Dim rng1 As Range

Set wbThis = ActiveWorkbook
Set wsThis = ActiveSheet

strName = ActiveSheet.Name

Set wbTarget = Workbooks.Open("C:\Users\Administrator\Desktop\Excel Testing\Excel Info Testing 2.xlsx")
Set wsTarget = wbTarget.Worksheets(strName)

Set rng1 = Selection

For i = 1 To 4
    If i = 1 Then
    wsThis.Range(rng1).Copy Destination:=wsTarget.Range("E5") **'<~Error occurs here**
    Set rng1 = rng1.Offset(0, 1)

    ElseIf i = 2 Then
    wsThis.Range(rng1).Copy Destination:=wsTarget.Range("G5")
    Set rng1 = rng1.Offset(0, 1)

    ElseIf i = 3 Then
    wsThis.Range(rng1).Copy Destination:=wsTarget.Range("I5")
    Set rng1 = rng1.Offset(0, 1)

    Else
    wsThis.Range(rng1).Copy Destination:=wsTarget.Range("K5")
    Set rng1 = rng1.Offset(0, 1)

    End If
    Next i

Application.CutCopyMode = False

wbTarget.Save
wbTarget.Close

Set wbTarget = Nothing
Set wbThis = Nothing

结束子

Answer 1

rng1 已经是一个范围，所以

wsThis.Range(rng1).Copy Destination:=wsTarget.Range("E5")

应该是

rng1.Copy Destination:=wsTarget.Range("E5")

还可能想要设置rng1 在打开另一个工作簿之前 修改了一下：

Sub CopyItemsByLocation()

    Const WB As String = "C:\Users\Administrator\Desktop\Excel Testing\Excel Info Testing 2.xlsx"
    Dim wbTarget As Workbook
    Dim wsTarget As Worksheet
    Dim rng1 As Range

    Set rng1 = Selection.Cells(1) 'in case of >1 cell selected

    Set wbTarget = Workbooks.Open(WB)
    Set wsTarget = wbTarget.Worksheets(rng1.Parent.Name)

    rng1.Copy wsTarget.Range("E5")
    rng1.Offset(0, 1).Copy wsTarget.Range("G5")
    rng1.Offset(0, 2).Copy wsTarget.Range("I5")
    rng1.Offset(0, 3).Copy wsTarget.Range("K5")

    Application.CutCopyMode = False

    wbTarget.Save
    wbTarget.Close

End Sub