CODEWITHSUNDEEP
vbaexcel
jhovyn
jhovyn

Reputation: 265

VBA - copy area and paste area aren't the same size error?

Good Day! I have these code below which it gives me an error of "We can't paste because copy area and paste area arent the same size".. Please help what is wrong with these code... :(

Option Explicit

Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True


Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"

For Each sh In ActiveWorkbook.Worksheets

    If IsError(Application.Match(sh.Name, _
                                 Array(DestSh.Name, "Information"), 0)) Then

        Last = LastRow(DestSh)

        If sh.Name = "Sheet1" Then
            Set CopyRng = sh.Range("A:G")
        End If

        If sh.Name = "Sheet2" Then
            Set CopyRng = sh.Range("B:G")
        End If

        If sh.Name = "Sheet3" Then
            Set CopyRng = sh.Range("C:G")
        End If

        CopyRng.Copy
        With DestSh.Cells(Last + 1, "A")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With

    End If
Next

 ExitTheSub:

Application.GoTo DestSh.Cells(1)

DestSh.Columns.AutoFit

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
 End Sub

Below is my Function

Option Explicit

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(what:="*", _
                        After:=sh.Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(what:="*", _
                        After:=sh.Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
On Error GoTo 0
End Function

Upvotes: 2

Views: 14517

Answers (1)

A.S.H
A.S.H

Reputation: 29352

Your source ranges are defined as Full Columns. Therefore you cannot paste them anywhere except somewhere at the first row of the destination sheet.

Remember that the number of rows in a worksheet is limited: 1048576 rows in Excel 2007 and later versions (65536 rows in Excel 2003). Therefore when you try to paste a full column somewhere not in the first row, the copy will exceed the last available row in the destination.

What you can do is take only the used part of the source columns, hoping that there is room for them in the destination sheet. To do this, change the way you define the source range, so that you take only the used part. i.e.:

Set CopyRng = sh.UsedRange.Columns("A:G")
'               ^^^^^^^^^^^^^^^^^^^

Do the same for all the cases where you set the CopyRng.

Alternatively, you can find the last used row and last used column of the source worksheet the same way you are doing it for the destination worksheet. This option should be more accurate and safer.

Upvotes: 1

Related Questions