VBA Copying Into/Out of An Array Between Workbooks

[beartooth91]

Hey Everyone -

I'm trying to copy data out of one workbook and append it to another workbook. Both workbooks have the same name but in different folders with different data. Renaming either one isn't an option.

I'm getting the 'application-defined or object-defined error' on the 'Set Destination....' line.

Any ideas on how to fix?

Sub Test_Copy_Same_Name()
Workbooks.Open Filename:=ThisWorkbook.Path & "/RTIME_Base" & "\" & "AIDESC.xlsx"
Dim lr As Long, myArray(), Destination As Range
With Workbooks("AIDESC.xlsx")
 
 lr = Cells(Rows.Count, "E").End(xlUp).Row
 myArray = Range("B2:AF" & lr)
End With
Workbooks("AIDESC.xlsx").Close SaveChanges:=False
Workbooks.Open Filename:=ThisWorkbook.Path & "/Bulk Update Sheets" & "\" & "AIDESC.xlsx"
With Workbooks("AIDESC.xlsx").Worksheets("Sheet1")
 
 lr = .Range("E" & Rows.Count).End(xlUp).Row
 Set Destination = .Range("C:AG" & lr)
 Destination.Resize(UBound(myArray, 2), UBound(myArray, 1)).Value = Application.Transpose(myArray)
 
 
End With
End Sub

 

[ExcelToDAX]

How about:

Sub Test_Copy_Same_Name()
    Workbooks.Open Filename:=ThisWorkbook.Path & "/RTIME_Base" & "\" & "AIDESC.xlsx"
    Dim lr As Long, myArray(), Destination As Range
    With Workbooks("AIDESC.xlsx").Worksheets(1)
        lr = .Cells(.Rows.Count, "E").End(xlUp).Row
        myArray = .Range("B2:AF" & lr).Value
    End With
    Workbooks("AIDESC.xlsx").Close SaveChanges:=False

    Workbooks.Open Filename:=ThisWorkbook.Path & "/Bulk Update Sheets" & "\" & "AIDESC.xlsx"
    With Workbooks("AIDESC.xlsx").Worksheets("Sheet1")
        lr = .Range("E" & .Rows.Count).End(xlUp).Row
        Set Destination = .Range("C" & lr + 1).Resize(UBound(myArray, 1), UBound(myArray, 2))
        Destination.Value = myArray
    End With
End Sub

If you notice with each With statement, I added a period before Cells and Range. When doing that, it better understands which workbook/worksheet you are referencing. You also didn't specify which worksheet you are referencing, so I included .Worksheets(1) to reference the very first worksheet. If you need to change it to a tab name you can do .Worksheets("Tab Name")

Also I would recommend using Power Query for this process instead of VBA.

 

[beartooth91]

How about:

Sub Test_Copy_Same_Name()
    Workbooks.Open Filename:=ThisWorkbook.Path & "/RTIME_Base" & "\" & "AIDESC.xlsx"
    Dim lr As Long, myArray(), Destination As Range
    With Workbooks("AIDESC.xlsx").Worksheets(1)
        lr = .Cells(.Rows.Count, "E").End(xlUp).Row
        myArray = .Range("B2:AF" & lr).Value
    End With
    Workbooks("AIDESC.xlsx").Close SaveChanges:=False

    Workbooks.Open Filename:=ThisWorkbook.Path & "/Bulk Update Sheets" & "\" & "AIDESC.xlsx"
    With Workbooks("AIDESC.xlsx").Worksheets("Sheet1")
        lr = .Range("E" & .Rows.Count).End(xlUp).Row
        Set Destination = .Range("C" & lr + 1).Resize(UBound(myArray, 1), UBound(myArray, 2))
        Destination.Value = myArray
    End With
End Sub

If you notice with each With statement, I added a period before Cells and Range. When doing that, it better understands which workbook/worksheet you are referencing. You also didn't specify which worksheet you are referencing, so I included .Worksheets(1) to reference the very first worksheet. If you need to change it to a tab name you can do .Worksheets("Tab Name")

Also I would recommend using Power Query for this process instead of VBA.

Its partially working.... Its overwriting the first 277 lines of data.

 

[beartooth91]

My bad; I forgot the two workbooks are offset by one column (see below). Your code works. Thank You!

Sub Test_Copy_Same_Name()
    Workbooks.Open Filename:=ThisWorkbook.Path & "/RTIME_Base" & "\" & "AIDESC.xlsx"
    Dim lr As Long, myArray(), Destination As Range
    With Workbooks("AIDESC.xlsx").Worksheets(1)
        lr = .Cells(.Rows.Count, "E").End(xlUp).Row
        myArray = .Range("B2:AF" & lr).Value
    End With
    Workbooks("AIDESC.xlsx").Close SaveChanges:=False

    Workbooks.Open Filename:=ThisWorkbook.Path & "/Bulk Update Sheets" & "\" & "AIDESC.xlsx"
    With Workbooks("AIDESC.xlsx").Worksheets("Sheet1")
        lr = .Range("F" & .Rows.Count).End(xlUp).Row  '<---- My Bad; the two workbooks are offset by one column; changed from "E" to "F"
        Set Destination = .Range("C" & lr + 1).Resize(UBound(myArray, 1), UBound(myArray, 2))
        Destination.Value = myArray
    End With
End Sub

 

[Peter_SSs]

Your code works. Thank You!

The marked solution has been changed accordingly. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread.