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

【问题标题】：Paste cells between existing data在现有数据之间粘贴单元格
【发布时间】：2019-11-01 11:14:03
【问题描述】：

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

因此，如果我选择合并的单元格 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

【问题讨论】：

这里的问题是无法通过“插入”来添加更多的列你能详细说明一下吗？据我所知Range("I:I").EntireColumn.insert Shift:=xlToRight 工作得很好。如果您要粘贴具有预定义范围的多个列 Range("H:I").EntireColumn.insert Shift:=xlToRight 就可以了。
是的，我的意思是在我的特殊情况下。这不是一个选项，因为我在上部单元格中有另一个数据。通过插入列会有间隙
在那种情况下我的答案将不起作用，所以我已经删除了。我看看能不能适应你的需要。
否则我也在考虑这个解决方案，因为它似乎很简单，但在工作表上遇到了其他数据的问题
我发现您仍然可以插入，只要您插入的选择与被移动的行的大小相同。请参阅我修改后的答案。

标签： excel vba

【解决方案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

【讨论】：