Problem with code for merged cells

[SuitedAces]

Please help me with this

Public Sub NamesAtTheTopOfTheTable()
Dim rng1 As Range
Dim rng2 As Range

With ThisWorkbook
Set rng1 = .Sheets("Totals").Range("F5:BM5") '<<== CHANGE
Set rng2 = .Sheets("test").Range("F5:BM5") '<<== CHANGE
End With

rng2.Copy Destination:=rng2

End Sub

I my cells are merged in pairs and when I do this copy the cells in
both ranges
become unmerged and the text shifts to the left running out of the
range.
Then I need to manually remerge each pair of cells.

 

[colofnature]

First, I take it you meant

rng1.Copy Destination:=rng2

?

Try, immediately after this line, using:

rng2.merge


Col

 

[SuitedAces]

That won't work because I have 60 cell and the are merged in pairs.
When I used that line of code it merges all the cells together and want
to
only take the data for the left most cell.

 

[SuitedAces]

That won't work because I have 60 cell and the are merged in pairs.
When I used that line of code it merges all the cells together and
wants to
only take the data for the left most cell.

 

[SuitedAces]

That won't work because I have 60 cell and the are merged in pairs.
When I used that line of code it merges all the cells together and
wants to
only take the data for the left most cell.

 

[SuitedAces]

Col

I have a sub that loops through all the cells and merges them in
pairs.


Thank you for the help.