VBA代码修改需求：实现多工作表数据追加至目标区域最后一行

问题核心 #

你当前代码的问题在于每次循环都固定把粘贴起点设为B2，导致新数据直接覆盖旧数据。要实现追加，关键是先找到Append工作表里数据区域的最后一行，再从该行的下一行开始粘贴。

修改后的完整代码 #

Sub CopyData()
    Dim tabNames() As Variant
    Dim sourceRange As Range
    Dim destinationStartRow As Long
    Dim i As Long
    Dim tabName As Variant
    Dim wsAppend As Worksheet
    
    ' 提前绑定目标工作表，减少重复调用开销
    Set wsAppend = ThisWorkbook.Sheets("Append")
    
    ' 待处理的工作表名称列表
    tabNames = Array("Tab1", "Tab2", "Tab3", "Tab4", "Tab5")
    
    ' 遍历每个源工作表
    For Each tabName In tabNames
        ' 定位源数据区域
        Set sourceRange = ThisWorkbook.Sheets(tabName).Range("B1:AI6")
        
        ' 取消源区域内的合并单元格，避免粘贴异常
        For Each unmergedCell In sourceRange
            If unmergedCell.MergeCells Then
                unmergedCell.MergeCells = False
            End If
        Next unmergedCell
        
        ' 找到Append表A列最后一行的下一行（用A列判断是因为它存工作表名称，数据连续性强）
        destinationStartRow = wsAppend.Cells(wsAppend.Rows.Count, "A").End(xlUp).Row + 1
        
        ' 复制源数据并转置粘贴到目标起始行的B列
        sourceRange.Copy
        wsAppend.Cells(destinationStartRow, "B").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        
        ' 在A列填充当前工作表名称，覆盖转置后的33行（源区域是6行33列，转置后为33行）
        wsAppend.Range(wsAppend.Cells(destinationStartRow, "A"), wsAppend.Cells(destinationStartRow + 32, "A")).Value = tabName
        
        ' 填充B、C列的空值，直接引用上一行内容赋值
        For i = destinationStartRow To destinationStartRow + 32
            If IsEmpty(wsAppend.Cells(i, "B")) Then
                wsAppend.Cells(i, "B").Value = wsAppend.Cells(i - 1, "B").Value
            End If
            If IsEmpty(wsAppend.Cells(i, "C")) Then
                wsAppend.Cells(i, "C").Value = wsAppend.Cells(i - 1, "C").Value
            End If
        Next i
        
        ' 清空剪贴板，避免后续操作干扰
        Application.CutCopyMode = False
    Next tabName
End Sub

关键修改说明 #

• 动态获取粘贴起点：通过wsAppend.Cells(wsAppend.Rows.Count, "A").End(xlUp).Row + 1精准定位空白起始行，彻底解决覆盖问题。
• 优化工作表引用：提前定义wsAppend变量，避免重复查找工作表，提升代码运行效率。
• 调整名称填充范围：根据源区域转置后的行数（33行），精准填充A列的工作表名称，避免多填或少填。
• 简化空值填充逻辑：直接用上一行的值赋值，替代原代码的公式转值操作，逻辑更清晰且高效。

额外提示 #

如果Append表有表头，确保表头在第一行（比如A1、B1为表头内容），这样End(xlUp)能正确识别数据的最后一行；也可以给代码加上工作表存在性检查，避免因工作表名称错误导致报错。

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