在现有数据之间粘贴单元格

Question

我有用于复制的代码-现有列之后的粘贴范围。有必要在现有的列之间也进行粘贴。因此，它将复制的范围粘贴到选定单元格之后的右下角。 这里的问题是，不可能通过使用“插入”来添加更多的列。因此，现有数据应以某种方式移至右侧。通过复制-粘贴？这是唯一的解决方案，以及如何在技术上实现？

因此，如果我选择合并的单元格H：I并单击ADD，则代码会将J：K和L：M移至右侧，并将复制的范围粘贴到最近J：K的位置。

我当前的ADD按钮代码是：

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

Answer 1

如您所言，您想在选择的右边插入整个列，但这并不像选择列那样容易，因为您要使用成对的2个合并的列。但是，如果您正确选择了副本，则仍然可以.Insert逐列复制整个范围。即使您希望插入两个大型合并的单元格，只要它们与行的其余部分大小相同，插入仍将起作用：

以下内容将调整复制区域的大小（从D13开始），以包括两列，以及所选区域下方的合并单元格的全部计数（加上D13的行）。然后它将复制整个区域并将其插入选择的右侧。 只要此选择框的大小与您选择的合并单元格的大小相同，就可以在不移动文档其余部分的情况下将其插入：

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