got an error 1004: we can do that to a merged cell.. why?

got an Error 1004: we can do that to a merged cell.. why ? how can I fix it ? I want to copy cell in twb to extwb... this code be like = run -> got an error -> reset macro -> run again -> it work

Sub Ke1()

Dim twb As Workbook
Dim extwb As Workbook
Dim rng As Range
Dim i As Long
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1


Set twb = Workbooks.Open("C:\Users\faisal.abraham\Documents\Faisal\Travel\CCCPU030732017.xlsx")
Set extwb = Workbooks.Open("C:\Users\faisal.abraham\Documents\Faisal\Travel\CCCPU030732018.xlsx")
'Set twb = Application.Workbooks("CCCPU030732017.xlsx")
'Set extwb = Application.Workbooks("CCCPU030732018.xlsx")

Set rng = twb.Worksheets("PAID").Range("A1:E500")
For i = 5 To rng.Cells(Rows.Count, 2).End(xlUp).Row

    rng.Cells(i, 1).Copy extwb.Worksheets("PAID").Cells(lastRow, 1)
    rng.Cells(i, 2).Copy extwb.Worksheets("PAID").Cells(lastRow, 2)
    rng.Cells(i, 3).Copy extwb.Worksheets("PAID").Cells(lastRow, 3)
    rng.Cells(i, 4).Copy extwb.Worksheets("PAID").Cells(lastRow, 4)
    rng.Cells(i, 5).Copy extwb.Worksheets("PAID").Cells(lastRow, 5)

    lastRow = lastRow + 1

Next i

twb.Close savechanges:=False
extwb.Saved = True

End Sub

1 answer

  • answered 2018-10-17 08:44 Rik Sportel

    You have merged cells in extwb.Worksheets("PAID") that you're trying to paste in.

    That's not going to work - The .Copy source needs to be the same size, i.e. if two cells are merged in the destination range, you need to have two merged cells in the source range.

    You can resolve this by doing:

    extwb.Worksheets("PAID").Range("A" & lastRow & ":E" & lastrow).Unmerge
    rng.Cells(i, 1).Copy extwb.Worksheets("PAID").Cells(lastRow, 1)
    rng.Cells(i, 2).Copy extwb.Worksheets("PAID").Cells(lastRow, 2)
    rng.Cells(i, 3).Copy extwb.Worksheets("PAID").Cells(lastRow, 3)
    rng.Cells(i, 4).Copy extwb.Worksheets("PAID").Cells(lastRow, 4)
    rng.Cells(i, 5).Copy extwb.Worksheets("PAID").Cells(lastRow, 5)