excelvbaruntime-error

Error code "1004" pasting from columns in several sheets within the same workbook to a workbook in a different location


I am trying to copy data from column "X" of multiple sheets within one workbook data to column "B" in an existing workbook in a different location.

I would like to paste the copied data into the next empty cell, and to repeat this for each sheet in the workbook.

Sub CopyColumnUFromDownloadToTurkey()
    Dim downloadWorkbook As Workbook
    Dim turkeyWorkbook As Workbook
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim sourceRange As Range
    Dim targetRange As Range
   
    ' Set the active workbook as Turkey
    Set turkeyWorkbook = ThisWorkbook
   
    ' Open the download workbook
    Set downloadWorkbook = Workbooks.Open("c:\myfiles\Turkey download.xlsx")
   
    ' Loop through each worksheet in the download workbook
    For Each ws In downloadWorkbook.Worksheets
        ' Find the last row in column A of the Turkey workbook
        lastRow = turkeyWorkbook.Sheets(1).Cells(turkeyWorkbook.Sheets(1).Rows.Count, 1).End(xlUp).Row + 1
       
        ' Set the source range to column U of the current worksheet
        Set sourceRange = ws.Columns("U")
       
        ' Copy the source range to the target range in the Turkey workbook
        sourceRange.Copy
        turkeyWorkbook.Sheets(1).Cells(lastRow, 1).PasteSpecial Paste:=xlPasteValues
    Next ws
   
    ' Close the download workbook
    downloadWorkbook.Close SaveChanges:=False
End Sub

Some of the rows of data are pasted but it stops and I get:

Run time error "1004"
You can't paste here because the Copy and paste area aren't the same size.
Select just one cell in the paste area that's the same size, and try pasting again.

The copied data has a header but there are no headers on the destination workbook.

I tried following the instructions from the debug help and also tried setting the columns for each workbook to the same width manually.


Solution

  • Without the copy/paste and only copying the occupied part of Col U:

    Sub CopyColumnUFromDownloadToTurkey()
        
        Dim downloadWorkbook As Workbook, ws As Worksheet, cDest As Range
        
        'first paste position
        With ThisWorkbook.Worksheets(1)
            Set cDest = .Cells(.Rows.count, "A").End(xlUp).Offset(1)
        End With
    
        Set downloadWorkbook = Workbooks.Open("c:\myfiles\Turkey download.xlsx")
       
        For Each ws In downloadWorkbook.Worksheets
            'range to copy...
            With ws.Range("U1:U" & ws.Cells(ws.Rows.count, "U").End(xlUp).Row)
                cDest.Resize(.Rows.count, .Columns.count).Value = .Value 'assign value directly
                Set cDest = cDest.Offset(.Rows.count)      'next paste position
            End With
        Next ws
       
        downloadWorkbook.Close SaveChanges:=False
    End Sub