无需打开源文件，从多份CSV提取指定列至对应Excel工作表

原代码问题分析 #

• 公式引用路径逻辑错误：应指向源CSV文件，而非目标Excel文件
• 未建立多源文件与多目标Sheet的对应映射关系
• CSV文件的外部引用格式不符合规范，且整列引用会加载大量无效空行

可行VBA代码实现 #

Sub ExtractFromCSVWithoutOpen()
    Dim wbDest As Workbook
    Dim wsDest As Worksheet
    Dim sourceFiles As Variant
    Dim destSheets As Variant
    Dim filePath As String
    Dim i As Integer
    Dim lastRow As Long
    
    ' 定义源文件与目标Sheet的一一对应关系
    sourceFiles = Array("SourceFile1.csv", "SourceFile2.csv", "SourceFile3.csv")
    destSheets = Array("Sheet1", "Sheet2", "Sheet3")
    
    ' 绑定目标工作簿（假设代码存储在DestinationFile.xlsx中）
    Set wbDest = ThisWorkbook
    
    ' 循环处理每一组文件与Sheet
    For i = LBound(sourceFiles) To UBound(sourceFiles)
        Set wsDest = wbDest.Sheets(destSheets(i))
        ' 拼接Documents文件夹下的源文件完整路径
        filePath = Environ("USERPROFILE") & "\Documents\" & sourceFiles(i)
        
        ' 清空目标Sheet原有数据
        wsDest.Cells.Clear
        
        ' 获取CSV文件中A列的有效行数，避免加载空行
        lastRow = ExecuteExcel4Macro("COUNTA('" & filePath & "'!A:A)")
        
        ' 分别写入A、C、E列数据到目标Sheet的A、B、C列
        wsDest.Range("A1:A" & lastRow).Formula = "='" & filePath & "'!A1"
        wsDest.Range("B1:B" & lastRow).Formula = "='" & filePath & "'!C1"
        wsDest.Range("C1:C" & lastRow).Formula = "='" & filePath & "'!E1"
        
        ' 将公式转换为静态值，断开与源文件的外部链接
        wsDest.UsedRange.Value = wsDest.UsedRange.Value
    Next i
    
    MsgBox "数据提取完成！", vbInformation
End Sub

代码关键说明 #

• 用Environ("USERPROFILE")自动获取当前用户的Documents路径，避免硬编码路径导致的兼容性问题
• 通过ExecuteExcel4Macro获取CSV的有效数据行数，仅加载实际有内容的范围，提升运行效率
• 循环逻辑实现多文件与多Sheet的批量处理，一次完成所有提取需求
• 最后将公式转为静态值，确保目标文件不依赖源CSV文件的存在状态

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