VBA宏多工作表数据追加时如何正确定义ThisWorkbook目标范围

问题根因 #

你现有代码的核心错误有两个：

1. 只计算了当前激活工作表的最后一行lRow，没有分别计算3个目标工作表各自的最后一行，三个表的数据行数不一样，不能共用同一个行号
2. 源区域是多行多列的二维数据，你直接赋值给目标工作表的单个单元格，Excel只会填充单个单元格的值，不会自动扩展匹配源范围的大小

修正后可直接运行的代码 #

Sub Import_SheetData_ThisWorkbook()
    Dim lRow1 As Long, lRow2 As Long, lRow3 As Long
    Dim targetLRow1 As Long, targetLRow2 As Long, targetLRow3 As Long
    Dim Path As String, WeeklyCollation As String
    Dim wkNum As Integer
    Dim wb As Workbook
    Dim sourceRng As Range
    
    wkNum = Application.InputBox("Enter week number")
    
    Path = "C:\xyz\"
    WeeklyCollation = Path & "Activities 2021 w" & wkNum & ".xlsx"
    
    Set wb = Workbooks.Open(WeeklyCollation)
    
    ' 处理Customer visits表
    lRow1 = wb.Sheets("Customer visits").Cells(Rows.Count, 1).End(xlUp).Row
    targetLRow1 = ThisWorkbook.Sheets("Customer visits").Cells(Rows.Count, 1).End(xlUp).Row + 1
    Set sourceRng = wb.Sheets("Customer visits").Range("A2:H" & lRow1)
    ThisWorkbook.Sheets("Customer visits").Range("A" & targetLRow1).Resize(sourceRng.Rows.Count, sourceRng.Columns.Count).Value = sourceRng.Value
    
    ' 处理Orders表
    lRow2 = wb.Sheets("Orders").Cells(Rows.Count, 1).End(xlUp).Row
    targetLRow2 = ThisWorkbook.Sheets("Orders").Cells(Rows.Count, 1).End(xlUp).Row + 1
    Set sourceRng = wb.Sheets("Orders").Range("A2:I" & lRow2)
    ThisWorkbook.Sheets("Orders").Range("A" & targetLRow2).Resize(sourceRng.Rows.Count, sourceRng.Columns.Count).Value = sourceRng.Value
    
    ' 处理Visits表
    lRow3 = wb.Sheets("Visits").Cells(Rows.Count, 1).End(xlUp).Row
    targetLRow3 = ThisWorkbook.Sheets("Visits").Cells(Rows.Count, 1).End(xlUp).Row + 1
    Set sourceRng = wb.Sheets("Visits").Range("A2:F" & lRow3)
    ThisWorkbook.Sheets("Visits").Range("A" & targetLRow3).Resize(sourceRng.Rows.Count, sourceRng.Columns.Count).Value = sourceRng.Value
    
    wb.Close SaveChanges:=False
    MsgBox "Data added"
End Sub

关键修改说明 #

• 新增了targetLRow1/2/3三个变量，分别计算每个目标工作表的空白起始行，避免共用行号出错
• 新增Resize方法，将目标单元格的范围扩展到和源数据范围完全一致的尺寸，保证所有值都能正确写入
• 移除了原来依赖ActiveSheet的错误行号计算逻辑，避免激活页不是目标表导致的行号错误

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