VBA复制指定行数据异常：仅复制S.no未同步整行关联信息

你当前代码只复制S.no列数据，是因为cellFrom1和cellTo1存储的是S.no列内的单个单元格地址（比如A3、A5），拼接后得到的是A3:A5这类单列范围，自然只会复制这一列，无法包含regNo、Name等其他关联列的数据。

要复制整行关联数据，需先提取目标单元格对应的行号，再选中整行或指定的数据列范围，最后复制到目标工作表的对应区域。

修改后的代码 #

基础调整版本（贴合你的原有逻辑） #

Sub copy_data()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim startRow As Long, endRow As Long
    
    ' 提前定义目标工作表，避免重复书写
    Set targetSheet = ThisWorkbook.Sheets("final")
    
    ' 处理I年级数据
    If pass1 = 1 Then
        Set sourceSheet = ThisWorkbook.Sheets("I yr")
        ' 从单元格地址提取起始/结束行号
        startRow = sourceSheet.Range(cellFrom1).Row
        endRow = sourceSheet.Range(cellTo1).Row
        ' 复制第1到第4列（对应S.no到Year）的行范围，可根据实际列数调整
        sourceSheet.Range(sourceSheet.Cells(startRow, 1), sourceSheet.Cells(endRow, 4)).Copy _
            Destination:=targetSheet.Cells(8, 2) ' 目标从B8开始
    End If
    
    ' 处理II年级数据
    If pass2 = 1 Then
        Set sourceSheet = ThisWorkbook.Sheets("II yr")
        startRow = sourceSheet.Range(cellFrom2).Row
        endRow = sourceSheet.Range(cellTo2).Row
        sourceSheet.Range(sourceSheet.Cells(startRow, 1), sourceSheet.Cells(endRow, 4)).Copy _
            Destination:=targetSheet.Cells(8, 2)
    End If
    
    ' 处理III年级数据
    If pass3 = 1 Then
        Set sourceSheet = ThisWorkbook.Sheets("III yr")
        startRow = sourceSheet.Range(cellFrom3).Row
        endRow = sourceSheet.Range(cellTo3).Row
        sourceSheet.Range(sourceSheet.Cells(startRow, 1), sourceSheet.Cells(endRow, 4)).Copy _
            Destination:=targetSheet.Cells(8, 2)
    End If
    
    ' 处理IV年级数据
    If pass4 = 1 Then
        Set sourceSheet = ThisWorkbook.Sheets("IV yr")
        startRow = sourceSheet.Range(cellFrom4).Row
        endRow = sourceSheet.Range(cellTo4).Row
        sourceSheet.Range(sourceSheet.Cells(startRow, 1), sourceSheet.Cells(endRow, 4)).Copy _
            Destination:=targetSheet.Cells(8, 2)
    End If
End Sub

进阶优化建议 #

1. 避免数据覆盖：如果需要多个年级的数据追加而非覆盖，可将目标起始行改为动态获取最后一行：

   ' 替换原有固定的目标起始行逻辑
   Dim targetStartRow As Long
   targetStartRow = targetSheet.Cells(targetSheet.Rows.Count, 2).End(xlUp).Row + 1
   

   后续复制时用targetSheet.Cells(targetStartRow, 2)作为目标位置即可。

2. 简化冗余代码：把重复的复制逻辑封装成子过程，减少代码量：

   Sub CopyRowsToFinal(sourceSheetName As String, cellFrom As String, cellTo As String)
       Dim sourceSheet As Worksheet
       Dim targetSheet As Worksheet
       Dim startRow As Long, endRow As Long
       Dim targetStartRow As Long
       
       Set sourceSheet = ThisWorkbook.Sheets(sourceSheetName)
       Set targetSheet = ThisWorkbook.Sheets("final")
       targetStartRow = targetSheet.Cells(targetSheet.Rows.Count, 2).End(xlUp).Row + 1
       
       startRow = sourceSheet.Range(cellFrom).Row
       endRow = sourceSheet.Range(cellTo).Row
       sourceSheet.Range(sourceSheet.Cells(startRow, 1), sourceSheet.Cells(endRow, 4)).Copy _
           Destination:=targetSheet.Cells(targetStartRow, 2)
   End Sub
   

   主过程可简化为：

   Sub copy_data()
       If pass1 = 1 Then CopyRowsToFinal "I yr", cellFrom1, cellTo1
       If pass2 = 1 Then CopyRowsToFinal "II yr", cellFrom2, cellTo2
       If pass3 = 1 Then CopyRowsToFinal "III yr", cellFrom3, cellTo3
       If pass4 = 1 Then CopyRowsToFinal "IV yr", cellFrom4, cellTo4
   End Sub
   

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