CODEWITHSUNDEEP
vbaexcel
excelguy
excelguy

Reputation: 1624

Pasting merge cells to new sheet are pasting unmerged

My current macro copies data from one page(A) and pastes in another(B).

In page A I have merged cells, when it pastes in B these cells are not merged.

Is there any code I can add to this to make sure the merged cells are not unmerged?

This is what I tried,

  Case paste_cx Like "*Merged Cells*" Or select_cx Like "*Print Area*" Or select_cx Like "*Box*"
        ActiveSheet.Paste
        Range(to_col_start & to_lin_start & ":" & to_col_end & to_lin_end).Copy
        Range(to_col_start & to_lin_start & ":" & to_col_end & to_lin_end).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Posting newly tried code:

     Case paste_cx Like "*Merged Cells*" Or select_cx Like "*Print Area*" Or select_cx Like "*Box*"
        ActiveSheet.Paste
        Range(to_col_start & to_lin_start & ":" & to_col_end & to_lin_end).Copy
        ''Range(to_col_start & to_lin_start & ":" & to_col_end & to_lin_end).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        With Range(to_col_start & to_lin_start & ":" & to_col_end & to_lin_end)   ''newly tested, doesnt work.
        .PasteSpecial Paste:=xlPasteValues
        .PasteSpecial Paste:=xlPasteFormats
        End With


        'if the last row is merged
        If Range(to_col_start & to_lin_end).End(xlUp).MergeCells And Len(Range(to_col_start & to_lin_end).End(xlUp).Value) > 20 Then
            Set rng = Range(to_col_start & to_lin_end).End(xlUp).MergeArea
        ElseIf Range(to_col_start & to_lin_end).MergeCells And Len(Range(to_col_start & to_lin_end).Value) > 20 Then
            Set rng = Range(to_col_start & to_lin_end).MergeArea
        End If

Upvotes: 1

Views: 1396

Answers (1)

Vityata
Vityata

Reputation: 43575

If you use the macro recorder and try to get what you need, you will see that xlPasteAllUsingSourceTheme is the PasteSpecial type, which keeps the merge cells. Thus, add this line additionally. It will keep the merge:

With Range(to_col_start & to_lin_start & ":" & to_col_end & to_lin_end)
    .PasteSpecial Paste:=xlPasteAllUsingSourceTheme
End With

If you want to keep both values and formats, use xlPasteValues and xlPasteFormats after each other:

With Range(to_col_start & to_lin_start & ":" & to_col_end & to_lin_end)
   .PasteSpecial Paste:=xlPasteValues
   .PasteSpecial Paste:=xlPasteFormats
End With

MSDN for XlPasteType Enumeration

Here is some minimal working example, of a code that copies range from the first worksheet and pastes it to the second. It takes care to copy the values and pastes the merged cells exactly as they are:

Public Sub TestMe()

    Dim mySourceRng As Range
    Dim myTargetRng As Range

    Set mySourceRng = Worksheets(1).Range("A1:F10")
    Set myTargetRng = Worksheets(2).Range("A1:F10")
    mySourceRng.Copy

    With myTargetRng
       .PasteSpecial Paste:=xlPasteValues
       .PasteSpecial Paste:=xlPasteFormats
    End With

    Application.CutCopyMode = False        
End Sub

Upvotes: 2

Related Questions