Excel VBA多工作表双向复制粘贴：合并后数据回推异常求助

问题说明 #

已实现CombineSheets子过程完成多工作表合并，但PushData无法将「Combine」工作表的修改数据回推至原工作表（原表实际名称为Doors、Casework、Floors，当前代码用Sheet1、Sheet2、Sheet3指代）。

原代码 #

Option Explicit

Sub CombineSheets()
    Dim wb As Workbook
    Dim ws As Worksheet, wsCombined As Worksheet
    Dim i As Long, j As Long, k As Long, lastrow As Long
    
    Set wb = ThisWorkbook
    Set wsCombined = wb.Sheets("Combine")
    
    'Clear the contents of the combined sheet
    wsCombined.Cells.Clear
    
    'Initialize last row variable to 0
lastrow = 0
    
    'Loop through each sheet to be combined
For k = 1 To 3
    Set ws = wb.Sheets("Sheet" & k)
    
    'Copy the data from the current sheet to the combined sheet
    For i = 1 To ws.UsedRange.Rows.Count
        For j = 1 To ws.UsedRange.Columns.Count
            wsCombined.Cells(lastrow + i, j).Value = ws.Cells(i, j).Value
        Next j
    Next i
    
    'Update the last row variable to the last row of the current sheet

    lastrow = wsCombined.UsedRange.Rows.Count
    
    lastrow = lastrow + 2 ' Add 2 for the empty rows between sheets
    Next k
    
    MsgBox "Sheets combined successfully!"
End Sub

Sub PushData()
    Dim wb As Workbook
    Dim ws As Worksheet, wsCombined As Worksheet
    Dim i As Long, j As Long, k As Long, lastrow As Long
    
    Set wb = ThisWorkbook
    Set wsCombined = wb.Sheets("Combine")
    
    'Initialize last row variable to 0
lastrow = 0

    'Loop through each sheet that was combined
    For k = 1 To 3
        Set ws = wb.Sheets("Sheet" & k)
        
        'Copy the data from the combined sheet back to the original sheet
        For i = 1 To ws.UsedRange.Rows.Count
            For j = 1 To ws.UsedRange.Columns.Count
            
                ws.Cells(i, j).Value = wsCombined.Cells(lastrow + i, j).Value
            Next j
        Next i
        lastrow = ws.UsedRange.Rows.Count + 2
    Next k
   
    MsgBox "Data pushed back successfully!"
End Sub

核心问题与解决思路 #

1. 原工作表名称不匹配 #

当前代码通过Sheets("Sheet" & k)获取原表，但实际原表名称是Doors、Casework、Floors，导致无法定位到正确的工作表。

解决方法：

• 将目标表名存入数组，避免硬编码：

  Dim sheetNames As Variant
  sheetNames = Array("Doors", "Casework", "Floors")
  

• 循环时从数组中取表名，替换原有的"Sheet" & k逻辑。

2. 合并/回推时的行号计算不准确 #

• CombineSheets中使用UsedRange.Rows.Count获取合并表最后一行，UsedRange可能因格式残留导致行号错误；
• PushData中使用原表的UsedRange.Rows.Count计算偏移量，若原表行数在合并后发生变化（比如原表新增/删除行），会导致回推数据位置错位。

解决方法：

• 改用Cells(Rows.Count, 1).End(xlUp).Row精准获取最后一行；
• 在合并时记录每个原表数据在Combine表中的起始/结束行，回推时直接使用这些记录的位置，避免依赖原表行数。

3. 单元格逐循环复制效率低下（可选优化） #

原代码通过双重循环逐单元格复制，大数量数据时效率极低，可改用区域批量复制：

ws.UsedRange.Copy wsCombined.Cells(lastrow + 1, 1)

修正后的完整代码 #

Option Explicit

Sub CombineSheets()
    Dim wb As Workbook
    Dim ws As Worksheet, wsCombined As Worksheet
    Dim k As Long, lastrow As Long
    Dim sheetNames As Variant
    
    Set wb = ThisWorkbook
    Set wsCombined = wb.Sheets("Combine")
    sheetNames = Array("Doors", "Casework", "Floors") ' 替换为实际表名
    
    ' 清空合并表
    wsCombined.Cells.Clear
    lastrow = 0
    
    For k = LBound(sheetNames) To UBound(sheetNames)
        Set ws = wb.Sheets(sheetNames(k))
        
        ' 批量复制数据，替代逐单元格循环
        ws.UsedRange.Copy wsCombined.Cells(lastrow + 1, 1)
        
        ' 更新合并表最后一行，加2空行间隔
        lastrow = wsCombined.Cells(wsCombined.Rows.Count, 1).End(xlUp).Row
        lastrow = lastrow + 2
    Next k
    
    MsgBox "Sheets combined successfully!"
End Sub

Sub PushData()
    Dim wb As Workbook
    Dim ws As Worksheet, wsCombined As Worksheet
    Dim k As Long, lastrow As Long, sourceRowStart As Long
    Dim sheetNames As Variant
    Dim originalRowCounts As Variant ' 存储每个原表的行数，用于回推定位
    
    Set wb = ThisWorkbook
    Set wsCombined = wb.Sheets("Combine")
    sheetNames = Array("Doors", "Casework", "Floors")
    ' 预先获取每个原表的行数，确保回推时位置准确
    originalRowCounts = Array(wb.Sheets("Doors").UsedRange.Rows.Count, _
                              wb.Sheets("Casework").UsedRange.Rows.Count, _
                              wb.Sheets("Floors").UsedRange.Rows.Count)
    
    lastrow = 0
    
    For k = LBound(sheetNames) To UBound(sheetNames)
        Set ws = wb.Sheets(sheetNames(k))
        sourceRowStart = lastrow + 1
        
        ' 批量回推数据
        wsCombined.Range(wsCombined.Cells(sourceRowStart, 1), _
                         wsCombined.Cells(sourceRowStart + originalRowCounts(k) - 1, ws.UsedRange.Columns.Count)).Copy _
                         ws.Cells(1, 1)
        
        ' 更新偏移量：原表行数 + 2空行
        lastrow = lastrow + originalRowCounts(k) + 2
    Next k
   
    MsgBox "Data pushed back successfully!"
End Sub

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