如何用VBA从指定单元格复制到最后有数据的单元格并粘贴到工作表

原代码核心问题 #

• 错误使用ActiveSheet获取最后行，可能指向非目标工作表
• Range地址拼接错误，"A16" & Lastrow会生成类似A16100的错误地址，格式完全不符合Range对象的要求
• 未使用传入的sheetName参数，固定取第一个工作表，与参数设计逻辑不符
• 未处理A16以下无数据的边界情况，会导致后续代码报错

修正后的完整代码 #

Public Sub CopyRangeToArray(ByVal filename As String _
                        , ByVal sheetName As String _
                        , ByRef data As Variant)

    Dim book As Workbook
    Set book = Workbooks.Open(filename, ReadOnly:=True)
    
    Dim sheet As Worksheet
    ' 使用传入的sheetName定位目标工作表，替代固定取第一个表的逻辑
    Set sheet = book.Worksheets(sheetName)
    
    Dim lastRow As Long, lastCol As Long
    ' 从目标工作表的A列获取最后有数据的行
    lastRow = sheet.Cells(sheet.Rows.Count, "A").End(xlUp).Row
    ' 获取A16行最后有数据的列，实现复制所有数据列
    lastCol = sheet.Cells(16, sheet.Columns.Count).End(xlToLeft).Column
    
    ' 边界处理：如果A16以下无数据，返回空数组避免后续报错
    If lastRow < 16 Then
        data = Empty
        book.Close SaveChanges:=False
        Exit Sub
    End If
    
    ' 正确拼接数据区域：从A16到最后行最后列的完整数据范围
    data = sheet.Range(sheet.Cells(16, "A"), sheet.Cells(lastRow, lastCol)).Value
    
    book.Close SaveChanges:=False

End Sub


Public Sub ArrayToRange(ByRef arr As Variant, rg As Range)
    ' 先判断数组是否为空，避免无数据时执行Resize报错
    If IsEmpty(arr) Then Exit Sub
    rg.Resize(UBound(arr, 1) - LBound(arr, 1) + 1, UBound(arr, 2) - LBound(arr, 2) + 1) = arr
End Sub


Private Sub CommandButton1_Click()

    Dim filename As Variant
    ' 优化文件筛选为仅Excel格式，避免选择非Excel文件导致错误
    filename = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx;*.xls),*.xlsx;*.xls", MultiSelect:=True)
    
    If IsArray(filename) = True Then
        
        Sheet2.Cells.ClearContents
        
        Dim file As Variant, data As Variant, rgDest As Range
        For Each file In filename
            
            Call CopyRangeToArray(file, "DATA", data)
                       
            ' 修正目标起始行判断，兼容目标表为空的情况
            Set rgDest = Sheet2.Range("A" & Sheet2.Rows.Count).End(xlUp)
            If rgDest.Row > 1 And rgDest.Value <> "" Then
                Set rgDest = rgDest.Offset(1)
            Else
                Set rgDest = Sheet2.Range("A1")
            End If
            
            Call ArrayToRange(data, rgDest)
        
        Next file
    
    End If

End Sub

关键修改说明 #

• 目标工作表定位：改用传入的sheetName参数获取工作表，替代固定取第一个表的硬编码逻辑
• 数据范围正确拼接：通过sheet.Cells对象组合出从A16到最后数据行/列的完整区域，彻底解决地址格式错误问题
• 边界场景处理：增加A16以下无数据的判断，以及目标表为空的起始行判断，避免代码报错
• 逻辑严谨性优化：将文件筛选限制为Excel格式，减少无效文件输入的风险

内容的提问来源于stack exchange，提问作者Mel Robert Omaña