VBA: Copy & paste area not the same size error

[Barraka]

Hi there,

I have the following code:

Sub test()
Sheets("try1").Select
Range("e2:e" & [e65000].End(xlUp).Row).SpecialCells(xlCellTypeConstants, 23).Copy Sheets("destination").Range("e2:e999").End(xlDown)
End Sub

What it does is copy all the non-empty cells from column E to a different sheet, at the same column.
It gives me an error message (error '1004', copy and paste area are not the same size). However this only happens if the destination column is empty. If I have a value in row 3, the macro works well (but it erases the value I had in E3).

Is there a workaround that problem?

Thanks for your help

 

[jeffreybrown]

I tried the whole On Error bit, but afraid I don't quite get it and its late.

Give this a whirl. If in Sheets("try1") there is only 1 cell then it exits the sub. May not get you where you want to be, but maybe mirabeau will help out.

Sub test()
    Dim rngSrc As Range
    Dim wsSrc As Worksheet: Set wsSrc = Sheets("try1")
    Dim lrSrc As Long: lrSrc = wsSrc.Range("E" & Rows.Count).End(xlUp).Row
    Dim wsDest As Worksheet: Set wsDest = Sheets("destination")
    Dim lrDest As Long: lrDest = wsDest.Range("E" & Rows.Count).End(xlUp).Offset(1).Row
    Application.ScreenUpdating = False
    
    If lrSrc = 1 Then: Exit Sub

    Set rngSrc = wsSrc.Range("E2:E" & lrSrc).SpecialCells(xlCellTypeConstants, 23)
    
    With wsSrc
        If wsDest.Range("E2").Value = "" Then
            rngSrc.Copy
            wsDest.Range("E2").PasteSpecial xlPasteValues
        Else
            rngSrc.Copy
            wsDest.Range("E" & lrDest).PasteSpecial xlPasteValues
        End If
    End With

    Application.ScreenUpdating = True
End Sub

 

[Barraka]

Thanks for your suggestion Jeffrey,

I managed to get what I wanted with the following code:

Sub Copier()
Dim lastVal As Integer
Dim caisseVal As Integer
caisseVal = 1
Do While caisseVal < 10

lastVal = Sheets("Caisse" & caisseVal).Range("h65000").End(xlUp).Row
If lastVal > 0 Then
Sheets("Caisse" & caisseVal).Range("h2:h" & Sheets("Caisse" & caisseVal).Range("h65000").End(xlUp).Row).Copy
Sheets("DepotCheques").Range("f65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End If

lastVal = Sheets("Caisse" & caisseVal).Range("j65000").End(xlUp).Row
If lastVal > 0 Then
Sheets("Caisse" & caisseVal).Range("=j2:j" & Sheets("Caisse" & caisseVal).Range("j65000").End(xlUp).Row).Copy
Sheets("DepotCheques").Range("h65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End If

I removed the

.SpecialCells(xlCellTypeConstants, 23).Copy

into simply

.Copy

because it didn't do the job when there is only 1 or 2 values in the source column, for some reason.
And I added a loop because there a 9 sheets from which the macro needs to do copy-paste operations.

Anyway, I think it works nicely this way, so thanks a lot for your help!

 

[borgem]

You might want to try to add this to the beginning of your code.

If IsEmpty(Sheets("try1").Range("E2")) Then Exit Sub