How to Selection.Insert Shift:=xlDown with keep destination formatting?

[bmba007]

I know working with merged cell is a bit tricky and one should avoid it, but I've got a situation where I copy a range of data and trying to paste it on different workbook using Selection.Insert Shift:=xlDown to avoid overwriting on data below the paste destination. But the range where I'm pasting the data contains merged cells and I want keep it that way but when I use Selection.Insert Shift:=xlDown on the destination it shows a message(

This operation will cause some merged cells to un-merge. Do you wish to continue?

) and after I hit OK it un-merges the destination cells and pastes the values in every single un-merged cells. How do I keep the cells merged?

the file that I'm copying from:
2411_01.jpg

the file where it is pasted:
2411_02.jpg

while it should look like:
2411_03.jpg
Please help!

[paulked]

Try this (change the sheet and ranges to suit. You may have to make the range dynamic!).

Sub Merge1()
    Dim i&
    Sheet1.Range("B2:B21").Copy
    With Sheet3
        .Range("A2:D2").Insert Shift:=xlDown
        For i = 2 To 21
            With .Range("A" & i & ":D" & i)
                .HorizontalAlignment = xlCenter
                .Merge
            End With
        Next
    End With
End Sub

[bmba007]

I'm using the copy part like this

    Cells.Find(What:="name", After:=ActiveCell, LookIn:=xlFormulas, _        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

How do I dynamically get the value of i in the for loop of yours?

[paulked]

Going through all the rows shouldn't have an impact on the time taken so:

    With Sheet3
        .Range("A2:D2").Insert Shift:=xlDown
        For i = 2 To .Cells(Rows.Count, 1).End(3).Row
            With .Range("A" & i & ":D" & i)
                .HorizontalAlignment = xlCenter
                .Merge
            End With
        Next
    End With

[bmba007]

Hi paulked,

I've applied your code with mine and when I run it, excel hangs, so I think going through all the rows isn't a good idea or maybe I'm somehow applying it wrong. Also, I'm getting the

This operation will cause some merged cells to un-merge. Do you wish to continue?

for each value pasting, how do I stop that too?

I've attached my test workbook for you to check.

Thanks.

[paulked]

Sub Macro1()
'
' Macro1 Macro
'


    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    Cells.Find(What:="country", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Copy
    
    With Sheet3
        .Range("B3:E3").Insert Shift:=xlDown
        For i = 3 To .Cells(Rows.Count, 2).End(3).Row - 1
            With .Range("B" & i & ":E" & i)
                .HorizontalAlignment = xlCenter
                .Merge
            End With
        Next
    End With
    
    MsgBox "Done"
    
    
    
    
    
    
    
    
    
    
    
'    Sheets("Sheet3").Select
'    Range("B3:E3").Select
'    Selection.Insert Shift:=xlDown
'    Selection.Columns.AutoFit
'    Range("A1").Select
End Sub

1. I corrected your typo End(4) to End(3) which is why it was doing all the rows in the sheet and not just the used rows, that caused it to 'hang'!!!
2. I added the application items to speed up your code and stop the alerts.
3. I added - 1 to the row count line so that your 4 cells with text at the end doesn't get merged - it wasn't there in the original.
4. You may want to get rid of the formatting of the borders, I think it looks terrible!!
5. Avoid merged cells!!!!

[bmba007]

Thanks paulked. One last thing, what does End(3) do? I mean I've seen

.End(xlUp/xlDown/xlToRight/xlToLeft)

but not a numeric value parameter.

[paulked]

As far as I am aware:

	VBA Constant	Alias
xlUp	-4162	3
xlToRight	-4161	2
xlToLeft	-4159	1
xlDown	-4121	4

No logic, but quicker to type!!