将最后两行复制/粘贴到下一个空行并清除某些单元格（包含合并的单元格）

Question

我正在尝试在我的工作表顶部创建一个命令按钮，按下该按钮将复制 A:AJ 列中包含数据的最后 2 行并粘贴到它们下方的下一个空行中。我希望复制源样式和公式，而不是手动输入的数据。我这里也有一张图片可以帮助您：

例如，从图像中。我想将第 105/106 行复制在一起，然后将它们粘贴到 107/108，因为它们是下一个空行（虽然隐藏，所以也需要取消隐藏这些行）。 除了底部的“笔画”部分和par/strokes框是我想要复制的公式/日期/数据验证/下拉列表之外，这两行中的所有内容都应该复制，但笔画部分为空，日期/下拉列表也为空.我希望它看起来都一样（复制样式）。在这种情况下要清除的填充单元格将是 B、C、E:M、P:X 列，但仅在“STROKES”行上。

更简单地说。我想要一个按钮来按下它将在表格中添加另一行。所以我在图片中有 52 个，你可以看到，当按下时，我现在下面有 53 个，它是空白的，可以使用了。

如果需要取消隐藏隐藏的行才能使其工作，我可以这样做。

我想尝试自己做，但我以前从未用 VBA 做过任何事情，所以我不知道。 我希望有人能理解这个要求，甚至是可行的。 谢谢。

根据 DecimalTurn 的回答，我做了一些更改，这是我的新代码：

Private Sub CommandButton1_Click()

'Find the last row based on column D (4th)
Dim LastRow As Long
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 4).End(xlUp).Row

'Copy the range
ActiveSheet.Range("A" & (LastRow - 1) & ":" & "AJ" & LastRow).Copy
ActiveSheet.Range("A" & (LastRow + 1) & ":" & "AJ" & LastRow + 2).PasteSpecial
Application.CutCopyMode = False 'This will clear the clipboard

'Adjust numbering
ActiveSheet.Range("A" & LastRow + 1).Value2 = ActiveSheet.Range("A" & LastRow - 1).Value2 + 1

'Clear content
Dim ListOfColumnsToClear1() As Variant
Dim ListOfColumnsToClear2() As Variant
ListOfColumnsToClear1 = Array("B:C")
ListOfColumnsToClear2 = Array("E:M", "P:X")

Dim i As Long
For i = LBound(ListOfColumnsToClear1) To UBound(ListOfColumnsToClear1)

    Intersect(ActiveSheet.Range("A" & (LastRow + 1) & ":" & "AJ" & LastRow + 2), ActiveSheet.Range(ListOfColumnsToClear1(i))).ClearContents

Next i
For i = LBound(ListOfColumnsToClear2) To UBound(ListOfColumnsToClear2)


    Intersect(ActiveSheet.Range("A" & (LastRow + 2) & ":" & "AJ" & LastRow + 2), ActiveSheet.Range(ListOfColumnsToClear2(i))).ClearContents

    Next i

End Sub

这可能是完全错误的，但它确实有效。

Answer 1

为了实现您尝试使用 VBA 执行的操作，我建议让您的代码执行以下操作（按此顺序）：

1. 找到最后一行数据。
2. 定义要复制的范围并复制该范围。
3. 调整行号
4. 清除需要手动输入的单元格内容。

假设您不需要取消隐藏任何行，代码如下所示：

Sub CopyLastTwoRows()

    'Find the last row based on column D (4th)
    Dim LastRow As Long
    LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 4).End(xlUp).Row

    'Copy the range
    ActiveSheet.Range("A" & (LastRow - 1) & ":" & "AJ" & LastRow).Copy
    ActiveSheet.Range("A" & (LastRow + 1) & ":" & "AJ" & LastRow + 2).PasteSpecial
    Application.CutCopyMode = False 'This will clear the clipboard

    'Adjust numbering
    ActiveSheet.Range("A" & LastRow + 1).Value2 = ActiveSheet.Range("A" & LastRow - 1).Value2 + 1

    'Clear content
    Dim ListOfColumnsToClear() As Variant
    ListOfColumnsToClear = Array("B:C", "E:M", "P:X")

    Dim i As Long
    For i = LBound(ListOfColumnsToClear) To UBound(ListOfColumnsToClear)

        Intersect(ActiveSheet.Range("A" & (LastRow + 2) & ":" & "AJ" & LastRow + 2), ActiveSheet.Range(ListOfColumnsToClear(i))).ClearContents

    Next i

End Sub

现在，由于您已合并单元格，因此我们清除数据的部分会给您一个错误，因为只有您的合并单元格的底部会相交。为了解决这个问题，我们可以使用一个函数来确保如果我们的范围内有合并的单元格，则它们的所有单元格都将被包括在内。

代码如下所示（注意末尾的新函数）：

Sub CopyLastTwoRows()

    'Find the last row based on column D (4th)
    Dim LastRow As Long
    LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 4).End(xlUp).Row

    'Copy the range
    ActiveSheet.Range("A" & (LastRow - 1) & ":" & "AJ" & LastRow).Copy
    ActiveSheet.Range("A" & (LastRow + 1) & ":" & "AJ" & LastRow + 2).PasteSpecial
    Application.CutCopyMode = False 'This will clear the clipboard

    'Adjust numbering
    ActiveSheet.Range("A" & LastRow + 1).Value2 = ActiveSheet.Range("A" & LastRow - 1).Value2 + 1

    'Clear content
    Dim ListOfColumnsToClear() As Variant
    ListOfColumnsToClear = Array("B:C", "E:M", "P:X")

    Dim i As Long
    For i = LBound(ListOfColumnsToClear) To UBound(ListOfColumnsToClear)

        ExpandToIncludeMergedCells(Intersect(ActiveSheet.Range("A" & (LastRow + 2) & ":" & "AJ" & LastRow + 2), ActiveSheet.Range(ListOfColumnsToClear(i)))).ClearContents

    Next i

End Sub

Private Function ExpandToIncludeMergedCells(ByRef Rng As Range) As Range

    Dim TempRange As Range
    Set TempRange = Rng.Cells(1)

    Dim c As Range
    For Each c In Rng

        Set TempRange = Union(TempRange, c.MergeArea)

    Next c

    Set ExpandToIncludeMergedCells = TempRange

End Function

最后，如果您想通过按下按钮多次（比如 10 次）执行此操作，您只需执行以下操作：

Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False

    Dim i As Long
    For i = 1 To 10
        CopyLastTwoRows
    Next i

    Application.ScreenUpdating = True

End Sub

请注意，我使用Application.ScreenUpdating = False 告诉 Excel 在宏运行时不要刷新屏幕。这将使您的代码运行得更快，但建议在最后将其设置回 true 并添加一些 error handling（我没有在此处包含）。