VBA功能扩展需求：多Excel文件A2:AA2区域数据合并至主表

原VBA代码仅支持选择单个Excel文件，将其首个工作表的A2:AA区域（从A2:AA2向下延伸至最后一行有数据的行）数据导入当前工作簿的xxx工作表。现需扩展为：

• 支持选择最多30个Excel文件
• 提供两种导入模式：
  • 模式1：直接将每个文件的数据依次追加到xxx工作表已有数据下方
  • 模式2：将所有文件的数据合并到一个临时工作表，方便后续手动处理

原代码存在逻辑缺陷：当MultiSelect:=True时，GetOpenFilename返回的是字符串数组而非单个字符串，原代码的判断和赋值逻辑无法处理多文件场景；同时使用Select/Activate操作容易导致运行异常，也降低了代码效率。以下是优化后的两个版本代码：

模式1：直接追加到主工作表xxx #

Sub ImportToMainSheet()
    Dim selectedFiles As Variant
    Dim fileCount As Integer
    Dim wbSource As Workbook
    Dim wsTarget As Worksheet
    Dim lastRowTarget As Long
    Dim sourceRange As Range
    
    ' 关闭屏幕更新，提升运行速度
    Application.ScreenUpdating = False
    ' 禁用警告提示
    Application.DisplayAlerts = False
    
    ' 设置目标工作表
    Set wsTarget = ThisWorkbook.Worksheets("xxx")
    
    ' 选择最多30个Excel文件
    selectedFiles = Application.GetOpenFilename( _
        FileFilter:="Excel文件 (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm", _
        Title:="选择要导入的Excel文件", _
        MultiSelect:=True)
    
    ' 判断是否选择了文件
    If IsArray(selectedFiles) Then
        fileCount = UBound(selectedFiles)
        ' 限制最多30个文件
        If fileCount > 30 Then
            MsgBox "最多只能选择30个文件，请重新选择！", vbExclamation
            GoTo Cleanup
        End If
        
        ' 遍历每个选中的文件
        Dim i As Integer
        For i = LBound(selectedFiles) To UBound(selectedFiles)
            ' 打开源文件
            Set wbSource = Application.Workbooks.Open(selectedFiles(i))
            
            ' 定位源数据区域：从A2开始，向下到最后一行有数据的行，列到AA列
            With wbSource.Sheets(1)
                ' 先确认A列有数据，避免空表报错
                If .Range("A2").Value <> "" Then
                    Set sourceRange = .Range("A2:AA" & .Cells(.Rows.Count, "A").End(xlUp).Row)
                Else
                    ' 如果A2为空，检查AA列是否有数据
                    If .Range("AA2").Value <> "" Then
                        Set sourceRange = .Range("A2:AA" & .Cells(.Rows.Count, "AA").End(xlUp).Row)
                    Else
                        ' 该行无数据，跳过当前文件
                        GoTo CloseSourceWb
                    End If
                End If
            End With
            
            ' 定位目标工作表的最后一行（A列）
            lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
            ' 若目标表A4以下无数据，从A5开始粘贴（对应原代码的A4.End(xlDown).Offset(1)逻辑）
            If lastRowTarget < 4 Then lastRowTarget = 4
            
            ' 粘贴值到目标表
            sourceRange.Copy
            wsTarget.Range("A" & lastRowTarget + 1).PasteSpecial Paste:=xlPasteValues
            
CloseSourceWb:
            ' 关闭源文件，不保存更改
            wbSource.Close SaveChanges:=False
        Next i
        
        MsgBox "共导入 " & fileCount & " 个文件的数据！", vbInformation
    Else
        MsgBox "未选择任何文件！", vbExclamation
    End If

Cleanup:
    ' 恢复Excel设置
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    ' 释放对象
    Set wsTarget = Nothing
    Set wbSource = Nothing
    Set sourceRange = Nothing
End Sub

模式2：合并到临时工作表 #

Sub ImportToTempSheet()
    Dim selectedFiles As Variant
    Dim fileCount As Integer
    Dim wbSource As Workbook
    Dim wsTemp As Worksheet
    Dim lastRowTemp As Long
    Dim sourceRange As Range
    Dim tempSheetName As String
    
    ' 关闭屏幕更新，提升运行速度
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 临时工作表名称（带时间戳避免重名）
    tempSheetName = "临时合并数据_" & Format(Now(), "YYYYMMDDHHMMSS")
    
    ' 创建新的临时工作表（若已存在则删除）
    On Error Resume Next
    Set wsTemp = ThisWorkbook.Worksheets(tempSheetName)
    If Not wsTemp Is Nothing Then
        wsTemp.Delete
    End If
    On Error GoTo 0
    Set wsTemp = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    wsTemp.Name = tempSheetName
    
    ' 选择最多30个Excel文件
    selectedFiles = Application.GetOpenFilename( _
        FileFilter:="Excel文件 (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm", _
        Title:="选择要导入的Excel文件", _
        MultiSelect:=True)
    
    ' 判断是否选择了文件
    If IsArray(selectedFiles) Then
        fileCount = UBound(selectedFiles)
        ' 限制最多30个文件
        If fileCount > 30 Then
            MsgBox "最多只能选择30个文件，请重新选择！", vbExclamation
            GoTo Cleanup
        End If
        
        ' 遍历每个选中的文件
        Dim i As Integer
        For i = LBound(selectedFiles) To UBound(selectedFiles)
            ' 打开源文件
            Set wbSource = Application.Workbooks.Open(selectedFiles(i))
            
            ' 定位源数据区域：从A2开始，向下到最后一行有数据的行，列到AA列
            With wbSource.Sheets(1)
                ' 先确认A列有数据，避免空表报错
                If .Range("A2").Value <> "" Then
                    Set sourceRange = .Range("A2:AA" & .Cells(.Rows.Count, "A").End(xlUp).Row)
                Else
                    ' 如果A2为空，检查AA列是否有数据
                    If .Range("AA2").Value <> "" Then
                        Set sourceRange = .Range("A2:AA" & .Cells(.Rows.Count, "AA").End(xlUp).Row)
                    Else
                        ' 该行无数据，跳过当前文件
                        GoTo CloseSourceWb
                    End If
                End If
            End With
            
            ' 定位临时表的最后一行（A列）
            lastRowTemp = wsTemp.Cells(wsTemp.Rows.Count, "A").End(xlUp).Row
            
            ' 粘贴值到临时表
            sourceRange.Copy
            wsTemp.Range("A" & lastRowTemp + 1).PasteSpecial Paste:=xlPasteValues
            
CloseSourceWb:
            ' 关闭源文件，不保存更改
            wbSource.Close SaveChanges:=False
        Next i
        
        ' 自动调整临时表列宽
        wsTemp.Columns("A:AA").AutoFit
        
        MsgBox "已将 " & fileCount & " 个文件的数据合并到临时工作表：" & tempSheetName, vbInformation
    Else
        MsgBox "未选择任何文件！", vbExclamation
    End If

Cleanup:
    ' 恢复Excel设置
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    ' 释放对象
    Set wsTemp = Nothing
    Set wbSource = Nothing
    Set sourceRange = Nothing
End Sub

关键优化点说明 #

• 多文件处理：通过遍历GetOpenFilename返回的字符串数组实现多文件导入，同时限制最多30个文件
• 避免Select操作：直接通过对象引用操作工作表和单元格，消除因选中其他工作表导致的运行错误
• 数据范围定位：先判断A2/AA2是否有数据，再通过Cells(.Rows.Count, "A").End(xlUp).Row获取最后一行，避免空行或全空列的异常
• 性能优化：关闭ScreenUpdating和DisplayAlerts，提升运行速度，减少弹窗干扰
• 错误处理：增加空文件判断、临时表重名处理，提升代码稳定性

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