将多个 CSV 导入到具有 CSV 文件名的单个 Excel 中到新列中

• CSV 文件名位于 A 列中。
• 导入的数据从 B 列开始。

Option Explicit
Sub Combinecsvs()
    Dim FolderPath As String
    Dim FileName As String
    Dim WbResult As Workbook
    Dim WB As Workbook
    FolderPath = "D:\Temp\csv"
    If FolderPath Like "*[!\/]" Then
        FolderPath = FolderPath & "\"
    End If
    FileName = Dir(FolderPath & "*.csv")
    Set WbResult = ActiveWorkbook
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Dim c As Range
    Do While FileName <> vbNullString
        Set WB = Workbooks.Open(FolderPath & FileName)
        With WbResult.ActiveSheet
            If Len(.Cells(1, 1)) = 0 Then
                Set c = .Cells(1, 1)
            Else
                Set c = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
            End If
            c.Value = FileName
            Set c = .Cells(1, .Columns.Count).End(xlToLeft).Offset(0, 1)
            WB.ActiveSheet.UsedRange.Copy c
        End With
        WB.Close False
        FileName = Dir()
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Microsoft 文档：

Range.End 属性 （Excel）

---

更新：

问题：我可以检查一下我是否允许用户选择导入 csv 文件的文件夹，我怎样才能在同一代码中做？

Option Explicit
Sub Combinecsvs()
    Dim FolderPath As String
    Dim FileName As String
    Dim WbResult As Workbook
    Dim WB As Workbook
    Dim dialog As FileDialog
    Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
    With dialog
        .Title = "Select a Folder"
        If .Show = -1 Then
            FolderPath = .SelectedItems(1) & "\"
        Else
            MsgBox "You cancelled the operation."
            Exit Sub
        End If
    End With
    FileName = Dir(FolderPath & "*.csv")
    Set WbResult = ActiveWorkbook
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Dim c As Range
    Do While FileName <> vbNullString
        Set WB = Workbooks.Open(FolderPath & FileName)
        With WbResult.ActiveSheet
            If Len(.Cells(1, 1)) = 0 Then
                Set c = .Cells(1, 1)
            Else
                Set c = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
            End If
            c.Value = FileName
            Set c = .Cells(1, .Columns.Count).End(xlToLeft).Offset(0, 1)
            WB.ActiveSheet.UsedRange.Copy c
        End With
        WB.Close False
        FileName = Dir()
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

在导入的每一行的 A 列中添加文件名。

Option Explicit

Sub Combinecsvs()

    Dim WbResult As Workbook, rngCSV As Range, rng As Range
    Dim wbCSV As Workbook, folderpath As String
    Dim FileName As String, n As Long
    
    folderpath = "C:\temp\so\csv"
    If folderpath Like "*[!\/]" Then
        folderpath = folderpath & "/"
    End If
    
    FileName = Dir(folderpath & "*.csv")
    Set WbResult = ActiveWorkbook
    
    Application.ScreenUpdating = False
    With WbResult.Sheets(1)
        Do While FileName <> vbNullString
            ' source
            Set wbCSV = Workbooks.Open(folderpath & FileName, ReadOnly:=True)
            Set rngCSV = wbCSV.Sheets(1).UsedRange
            
            ' target
            Set rng = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
            rngCSV.Copy rng.Offset(, 1)
            rng.Resize(rngCSV.Rows.Count) = FileName
            wbCSV.Close False
            n = n + 1
            
            FileName = Dir()
        Loop
    End With
    Application.ScreenUpdating = True
    
    MsgBox n & " csv files imported", vbInformation

End Sub