excelvbaexcel-2016

How to copy merged cells with VBA

I have 2 Excel file with same format but one is Master file (for calculating) and one file is extracted data from system. I want to copy extracted file's data to Master file with VBA but it didn't work.

File format looks like below: enter image description here

So I want to Copy from A1 to I200 and then Paste it to Master file but it raised error "To do this, all the merged cells need to be the same size" or "PasteSpecial method of Range class failed".

Below is my sample code:

Sub TransferData()

Dim main_wb As Workbook
Dim target_wb As Workbook

Application.ScreenUpdating = False

Set main_wb = Workbooks.Open("C:/Users/admin/Documents/Sample.xlsx")
main_sheet = "Sheet1"

Set target_wb = ThisWorkbook
target_sheet = "Sheet1"

main_wb.Sheets(main_sheet).Range("A1:I200").Copy
target_wb.Sheets(target_sheet).Range("A1").PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End Sub

What should I do to copy merged cells? Thank you.

Solution

  • If you want to copy only data, instead of using Copy and PasteSpecial, read the data into a 2-dimensional array and write the array data into the destination. This will keep the formatting of the destination intact, including merged areas. It will not throw an error if the destination contains merged areas that are different form the source.

    If the source and the destination have the same merged area, everything is fine anyhow (marked green).

    If the source contains a merged area where the destination has single (unmerged) cells, only the first cell of the destination is filled (marked yellow).

    If the source contains single cells where the destination has a merged array, the value of the first cell is copied (marked red).

    Source data:
    Source

    Destination (after copy):
    Destination

    Your code could look like this:

    Dim sourceRange As Range, destRange As Range
Set sourceRange = main_wb.Sheets(main_sheet).Range("A1:I200")
Set destRange = target_wb.Sheets(target_sheet).Range("A1").Resize(sourceRange.Rows.Count, sourceRange.Columns.Count)

Dim data As Variant
data = sourceRange.Value
destRange.Value = data