Will Cheng
Will Cheng

Reputation: 33

VBA Compilation Error (1004 Automation Error)

I am trying to write a program which would take the information from a user selected grid and the information adjacent to it and send them to another workbook. However, whenever I compile, I would get the error 1004 (Automation). Can someone please point out where I have made a mistake in my code? It will be greatly appreciated.

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

End Sub

Upvotes: 0

Views: 92

Answers (1)

Tim Williams
Tim Williams

Reputation: 166790

rng1 is already a range so

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

should be

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

Also might want to set rng1 before opening the other workbook Reworked a bit:

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

Upvotes: 1

Related Questions