单工作表主工作簿数据逐行追加至多工作表工作簿（VBA报错求助）

主工作簿EOD_DATA.xlsx（仅含Sheet1）的数据每分钟更新，Sheet1中每行数据需要对应追加到目标工作簿Temp_new.xlsm的指定工作表中（第1行数据追加到第1个工作表，第2行到第2个工作表，以此类推，目标工作簿有100+个工作表）。编写VBA代码时，在引用主工作表和目标工作表的单元格区域时出错，代码如下：

错误代码 #

wsCopy.Range(Cells(S, 2), Cells(S, 15)).Copy _
        'wsDest.Range("B" & lDestLastRow)

Sub copy_eachrow_from_master()

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
  

'EOD_DATA.xlsx is master workbook with Sheet1
'Temp_new.xlsm is having 100's of worksheets.

  Dim i As Long
  For i = 1 To 180
      Set wsCopy = Workbooks("EOD_DATA.xlsx").Worksheets("Sheet1")
      
     Set wsDest = Workbooks("Temp_new.xlsm").Worksheets(i)
     
     lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
             
    wsCopy.Range(Cells(i, 2), Cells(i, 15)).Copy _
        'wsDest.Range("A" & lDestLastRow)
        
    
    Next S
    MsgBox "Code done"
    

End Sub

错误分析 #

• 单元格引用未指定父工作表：Cells(i,2)和Cells(i,15)默认指向当前活动工作表，而非wsCopy，导致与wsCopy.Range的父对象不匹配，引发错误。
• 循环变量拼写错误：循环用i作为变量，但Next后面写的是S，导致循环无法正常结束。
• 粘贴语句被注释：复制操作后没有执行粘贴，数据无法写入目标工作表。
• 不必要的重复赋值：Set wsCopy放在循环内，每次循环都会重新赋值，降低代码效率。

修正后的代码 #

Sub copy_eachrow_from_master()
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim lDestLastRow As Long
    Dim i As Long
    
    ' 提前绑定主工作表，避免循环内重复赋值
    Set wsCopy = Workbooks("EOD_DATA.xlsx").Worksheets("Sheet1")
    
    ' 遍历1到180行/对应工作表
    For i = 1 To 180
        ' 绑定目标工作表
        Set wsDest = Workbooks("Temp_new.xlsm").Worksheets(i)
        
        ' 找到目标工作表A列最后一行的下一行（用于追加数据）
        lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
        
        ' 复制主工作表第i行的B到O列（对应列2到15），粘贴到目标工作表的对应行
        wsCopy.Range(wsCopy.Cells(i, 2), wsCopy.Cells(i, 15)).Copy _
            Destination:=wsDest.Range("B" & lDestLastRow) ' 可根据需求调整目标列
            
        ' 若不需要格式，可直接赋值提升效率：
        ' wsDest.Range(wsDest.Cells(lDestLastRow, 2), wsDest.Cells(lDestLastRow, 15)).Value = _
        '     wsCopy.Range(wsCopy.Cells(i, 2), wsCopy.Cells(i, 15)).Value
    Next i
    
    MsgBox "执行完成"
End Sub

额外说明 #

1. 确保两个工作簿都已打开，否则代码会报错；若需支持未打开的工作簿，可添加Workbooks.Open语句并指定文件路径。
2. 若目标工作表数量不足180，代码会抛出下标越界错误，可提前判断工作表数量：If Workbooks("Temp_new.xlsm").Worksheets.Count < i Then Exit For。
3. 直接赋值（注释部分）比Copy/Paste速度更快，适合大数据量场景，且不会复制格式。

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