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

Question

我有用于在现有列之后复制粘贴范围的代码。还需要能够在现有列之间涂抹它。因此，它将在选定单元格之后将复制的范围粘贴到右侧。这里的问题是不可能通过使用“插入”来添加更多列。所以现有数据应该以某种方式向右移动。通过复制粘贴？它是唯一的解决方案吗？如何在技术上完成？

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

我当前的添加按钮代码是：

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

标签： excelvba

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