Copy and paste Merged cells from one worksheet to another(with formatting)

[Macro_Nerd99]

How do I copy and paste a Merged Cell (A2:C2) from one worksheet into another merged cell (D2:G36) of another worksheet AND keep the formatting.
The Text in cell A2:C2 is large and so I have merged cells from D2:G36, so that when you paste it, you can view all the data of the cell in the template.

If this isn't possible, How do I copy and paste the text of the merged cell (A2:C2) to Cell D2 and then "Merge and center" from D2:G36?

I keep getting a VBA Runtime Error 1004 "Application-defined or Object-defined error" on any Method I use.

Any advise on a better way to achieve the same results is also appreciated.
Thanks.

 

[jolivanes]

Merged cells are an accident waiting to happen.
If you do a google you'll find out why.
The use of "Center across Selection" is usually suggested to replace it.

To retrieve the merged area's value/text:

x = Range("A2").MergeArea.Cells(1, 1).Value

To set a Range as merged:

Sub Merge_A_Range()
    With Range("D2:G36")
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
End Sub

 

[Macro_Nerd99]

Merged cells are an accident waiting to happen.
If you do a google you'll find out why.
The use of "Center across Selection" is usually suggested to replace it.

To retrieve the merged area's value/text:

x = Range("A2").MergeArea.Cells(1, 1).Value

To set a Range as merged:

Sub Merge_A_Range()
    With Range("D2:G36")
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
End Sub

I researched the "Center across Selection" idea, and it works great, but only for Horizontal Alignment. Like I was saying, I have a lot of text in the original cell so I have to merge vertically to view all the text. Do you have a better recommendation to achieve this?

Also, I don't see anywhere how you paste AND keeping the formatting. In Cell A2:C2 I have a lot of text with a mixture of bold and regular text, and some black and some red. When pasting, is there a way to paste it EXACTLY the way it is displayed in the original location? when I use "Paste:=xlPasteFormats" it turns ALL the text to bold and I don't want that.

Thanks for your help.

 

[jolivanes]

Re: "view all the text"
Set ColumnWidth to equivalent of 4 columns and use WrapText.


What are all the different formats you have?
Different colors, bold/regular, maybe Italic, different font size, underline and whatever is available.

 

[Alex Blakenburg]

I agree with @jolivanes that merged cells are too be avoided like the plague and will come back to bite, as this issue alone shows.
This is a bit of workaround and there is quite a bit of code, so it may be worth making it into a function that you pass the source and destination cells to.

Sub UnmergeCopyMerge()

    Dim srcRng As Range
    Dim destRng As Range
    Dim destCells As Range
    Dim destHAlign As Long, destVAlign As Long, destWrap As Boolean
    
    Set srcRng = Range("A2")
    Set destRng = Range("D2")
    
    Set destCells = destRng.MergeArea.Cells
    With destRng.MergeArea
        destHAlign = .HorizontalAlignment
        destVAlign = .VerticalAlignment
        destWrap = .WrapText
    End With
    
    destRng.MergeArea.UnMerge
    srcRng.MergeArea.Copy destRng
    
    With destCells
        .Merge
        .HorizontalAlignment = destHAlign
        .VerticalAlignment = destVAlign
        .WrapText = destWrap
    End With

End Sub

 

[jolivanes]

You haven't answered my questions in Post #4 yet so what it does now only is copy Font.Name, Font.Size, Font.Color and Font.Bold (Yes or No)
You can add whatever you need to it.
Check and change references (Sheet names, ranges, cell addresses etc) as and where required.
The macro can be made more compact but I will leave that up to you.

Sub Maybe_So()
Dim x, fArr(0 To 3)
Dim j As Long, i As Long
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Worksheets("Sheet2")
Set sh2 = Worksheets("Sheet3")
Application.ScreenUpdating = False
    With sh1.Cells(2, 1)    '<---- Sheet2, Range("A2") Merge Area
        .MergeArea.UnMerge
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
    End With
    With sh2.Cells(2, 4)    '<---- Sheet3, Range("D2") Merge Area
        .MergeArea.UnMerge
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
    End With
sh2.Cells(2, 4).Value = sh1.Cells(2, 1).Value    '<---- Sheet3 Range("D2"), Sheet2 Range("A2")
x = Split(sh1.Cells(2, 1), " ")    '<---- Sheet2 Range("A2")
j = 1
    For i = 1 To UBound(x) + 1
        With sh1.Cells(2, 1)    '<---- Sheet2 Range("A2")
            fArr(0) = .Characters(j, Len(x(i - 1))).Font.Name
            fArr(1) = .Characters(j, Len(x(i - 1))).Font.Bold
            fArr(2) = .Characters(j, Len(x(i - 1))).Font.Color
            fArr(3) = .Characters(j, Len(x(i - 1))).Font.Size
        End With
        With sh2.Cells(2, 4)    '<---- Sheet3 Range("D2")
            .Characters(j, Len(x(i - 1))).Font.Name = fArr(0)
            .Characters(j, Len(x(i - 1))).Font.Bold = fArr(1)
            .Characters(j, Len(x(i - 1))).Font.Color = fArr(2)
            .Characters(j, Len(x(i - 1))).Font.Size = fArr(3)
        End With
        j = j + Len(x(i - 1)) + 1
    Erase fArr()
    Next i
    With sh1.Cells(2, 1).Resize(, 3)    '<---- Sheet2 Range("A2") Merge Area
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .MergeCells = True
    End With
    With sh2.Cells(2, 4).Resize(35, 4)    '<---- Sheet3 Range("D2") Merge Area
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .MergeCells = True
    End With
Application.ScreenUpdating = True
End Sub

 

[jolivanes]

As you can see, Alex's code is considerable shorter, easier and better.
If nothing else, you might in the future have a use for some of it.