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:
25482

the file where it is pasted:
25483

while it should look like:
25484
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!!