Paste cells between existing data

Question

I have code for copy - pasting range after existing columns. There is a need to be able to baste it also between existing columns. So it will paste copied range to the right next after selected cell. The problem here is that there is no possibility to add more columns by using "Insert". So existing data should be somehow moved to the right. By copy - paste? Is it the only solution and how it can be done technically?

So if I select merged cells H:I and hit ADD, code will move J:K and L:M to the right and paste copied range to the place where J:K has been recently.

My current code for ADD button is:

Sub CopyPasteTurbineOwnWork()
Application.ScreenUpdating = False
Dim StartRange As Range
Dim cello As Range

Set cello = Worksheets("Price calculation").Cells(13, Columns.Count)

Set StartRange = Worksheets("Price calculation").Range("D13")

StartRange.MergeArea.Copy
cello.End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteAll

StartRange.Offset(1, 0).Resize(16, 2).Copy
cello.End(xlToLeft).Offset(1, 0).PasteSpecial xlPasteAll

StartRange.Offset(17, 0).MergeArea.Copy
cello.End(xlToLeft).Offset(17, 0).PasteSpecial xlPasteAll

StartRange.Offset(18, 0).Resize(2, 2).Copy
cello.End(xlToLeft).Offset(18, 0).PasteSpecial xlPasteAll

StartRange.Offset(148, 0).MergeArea.Copy
cello.End(xlToLeft).Offset(148, 0).PasteSpecial xlPasteAll

StartRange.Offset(149, 0).Resize(5, 2).Copy
cello.End(xlToLeft).Offset(149, 0).PasteSpecial xlPasteAll

Set StartRange = Nothing
Set pasteSheet = Nothing
Set cello = Nothing

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

The problem here is that there is no possibility to add more columns by using "Insert" Can you elaborate? As far as I know Range("I:I").EntireColumn.insert Shift:=xlToRight works just fine. If you're pasting multiple columns Range("H:I").EntireColumn.insert Shift:=xlToRight with a pre-defined range would do it. — Plutian
Yes, I mean in my particular case. This is not an option, because I have another data in upper cells. By inserting columns there will gaps — hatman
In that case my answer will not work, so I've deleted. I'll see if I can adapt it to your needs. — Plutian
Otherwise I was also thinking about this solution as it seemed to be as an easy one, but came up to the problems with other data on he sheet — hatman
I found out that you can still insert, as long as your inserted selection is the same size as the rows being shifted. See my revised answer. — Plutian

Plutian Plutian · Accepted Answer · 2019-11-01T11:56:17

As you state you want the entire column right of your selection inserted, but this isn't as easy as selecting the column since you're working with pairs of 2 merged columns. However rather than copying your entire range column by column, you can still .Insert if you make the copy selection correct. Even if you wish to insert two massive merged cells, as long as they are the same size as the rest of the row, insert will work:

The following will resize your copied area (starting at D13) to include two columns, and the entire count of the merged cell of the one below the selected (plus the row of D13). It will then copy this entire area and insert it to the right of the selection. As long as this selecton is the same size of the merged cells to the right of your selection, this can be inserted without shifting the rest of the document:

Sub insert_column()

Range("D13").Resize((Selection.Offset(1, 0).MergeArea.Rows.Count) + 1, 2).Copy

Selection.Offset(0, 1).insert shift:=xlToRight

End Sub

Paste cells between existing data

1 Answers