Excel点击按钮重复复制选定表格的VBA问题求解

需求说明 #

需要在预算工作表实现以下交互逻辑：

• 点击「合同」按钮自动插入对应合同表格，首次点击直接插入，后续每次点击先预留1个空行，再追加插入新的合同表格
• 点击「变更」按钮实现和上述逻辑一致的变更表格插入效果

参考素材 #

• 预算工作表界面：
• 待复制表格样例：
• 现有尝试效果：

原有代码问题 #

当前使用的基础VBA代码固定将源区域复制到目标表固定位置，每次运行都会覆盖已有内容，无法实现追加效果：

Sub CopyPasteToAnotherSheet()
    Worksheets("Dataset").Range("B2:F9").Copy Worksheets("CopyPaste").Range("B2")
End Sub

实现方案 #

核心逻辑为每次执行宏时自动定位目标表表格起始列的最后一行有内容的单元格，自动计算下一次粘贴的起始位置：首次粘贴直接使用预设起始行，非首次粘贴则在最后一行后留1行空行再粘贴。
以下为可直接使用的代码，可根据自身实际的模板存放位置、目标工作表名修改代码内的常量参数：

' 给合同按钮绑定该宏
Sub InsertContractTable()
    ' ===== 可根据实际场景修改以下参数 =====
    Const SOURCE_SHEET As String = "Dataset"       ' 模板存放工作表名
    Const SOURCE_RANGE As String = "B2:F9"         ' 合同模板的单元格区域
    Const TARGET_SHEET As String = "预算"          ' 粘贴目标工作表名
    Const TARGET_START_COL As String = "B"         ' 表格粘贴的起始列
    Const FIRST_PASTE_ROW As Long = 2              ' 首次粘贴的起始行号
    ' ==================================
    
    Dim wsTarget As Worksheet
    Dim lastRow As Long, pasteRow As Long
    
    Set wsTarget = ThisWorkbook.Worksheets(TARGET_SHEET)
    ' 定位目标列最后一个有内容的行号
    lastRow = wsTarget.Cells(wsTarget.Rows.Count, TARGET_START_COL).End(xlUp).Row
    
    ' 计算本次粘贴的起始行
    If lastRow < FIRST_PASTE_ROW Then
        pasteRow = FIRST_PASTE_ROW
    Else
        ' 最后一行+1为空行，+2为新表格起始位置
        pasteRow = lastRow + 2
    End If
    
    ' 执行复制粘贴
    ThisWorkbook.Worksheets(SOURCE_SHEET).Range(SOURCE_RANGE).Copy _
        Destination:=wsTarget.Cells(pasteRow, TARGET_START_COL)
End Sub

' 给变更按钮绑定该宏
Sub InsertChangeTable()
    ' ===== 可根据实际场景修改以下参数 =====
    Const SOURCE_SHEET As String = "Dataset"       ' 模板存放工作表名
    Const SOURCE_RANGE As String = "B12:F19"       ' 替换为变更模板实际的单元格区域
    Const TARGET_SHEET As String = "预算"          ' 粘贴目标工作表名
    Const TARGET_START_COL As String = "B"         ' 表格粘贴的起始列
    Const FIRST_PASTE_ROW As Long = 2              ' 若变更表单独用一块区域，修改此处起始行即可
    ' ==================================
    
    Dim wsTarget As Worksheet
    Dim lastRow As Long, pasteRow As Long
    
    Set wsTarget = ThisWorkbook.Worksheets(TARGET_SHEET)
    lastRow = wsTarget.Cells(wsTarget.Rows.Count, TARGET_START_COL).End(xlUp).Row
    
    If lastRow < FIRST_PASTE_ROW Then
        pasteRow = FIRST_PASTE_ROW
    Else
        pasteRow = lastRow + 2
    End If
    
    ThisWorkbook.Worksheets(SOURCE_SHEET).Range(SOURCE_RANGE).Copy _
        Destination:=wsTarget.Cells(pasteRow, TARGET_START_COL)
End Sub

按钮绑定操作步骤 #

1. 打开Excel「开发工具」选项卡，点击「设计模式」进入控件编辑状态
2. 选中预算工作表内的「合同」按钮，右键选择「指定宏」，在弹出列表中选中InsertContractTable后确认
3. 同理选中「变更」按钮，右键为其指定宏InsertChangeTable
4. 再次点击「设计模式」退出编辑状态，即可点击按钮测试追加粘贴效果

提示：如果后续需要调整模板大小、粘贴位置，只需要修改对应宏中参数块的配置值即可，不需要改动核心逻辑代码。

内容的提问来源于stack exchange，提问作者Mav01