получил ошибку 1004: мы можем сделать это для объединенной ячейки .. почему?

Question

получил Ошибка 1004: мы можем сделать это для объединенной ячейки .. почему?как я могу это исправить?Я хочу, чтобы скопировать ячейку в TWB в ExtWB ... этот код будет как = запустить -> получил ошибку -> сбросить макрос -> запустить еще раз -> это работает

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

Answer 1

Вы объединили ячейки в extwb.Worksheets("PAID"), которые пытаетесь вставить.

Это не сработает - источник .Copy должен быть одинакового размера, т.е. если две ячейки объединеныв целевом диапазоне вам нужно иметь две объединенные ячейки в исходном диапазоне.

Чтобы решить эту проблему, выполните:

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)