将.csv文件合并到一个工作簿中的多个工作表中

Question

我想拉入一组选定的.csv文件，然后将每个文件添加到工作簿的各自工作表中，以将所有数据合并到一个Excel工作簿中。 我无法为每张表单上的文件名称命名表单。我搜索了很多，并有各种评论的方式，我尝试过，没有工作。这是我到目前为止：

Sub R_AnalysisMerger() 
Dim WSA As Object 
Dim bookList As Workbook 
Dim SelectedFiles() As Variant 
Dim NFile As Long 
Dim FileName As String 

Application.ScreenUpdating = False 

'change folder path of excel files here 
SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.csv*), *.csv*", MultiSelect:=True) 

For NFile = LBound(SelectedFiles) To UBound(SelectedFiles) 


    FileName = SelectedFiles(NFile) 
    Set bookList = Workbooks.Open(FileName) 
    Set WSA = ThisWorkbook.Worksheets.Add 
    'ActiveSheet.Name = Left(FileName, 31) 
    'ActiveWorksheet.Name.Add Name:= FileName 
    'ActiveWorkbook.Name Name:=FileName 
    'ThisWorkbook.Sheets.Name.Add (FileName) 

    'Change " A1" to the starting point for each file. 
    'Also change "A" column on "A10000" to the same column as start point 
    Range("A1:IV" & Range("A100000").End(xlUp).Row).Copy 
    ThisWorkbook.Worksheets(1).Activate 

    'Column 
    Range("A100000").End(xlUp).Offset(0, 0).PasteSpecial 
    Application.CutCopyMode = False 
    Cells.EntireColumn.AutoFit 
    bookList.Close 
    'ActiveWorkbook.Close 

Next 
Sheets("Sheet1").Select 
Range("A1").Select 

End Sub 

Answer 1

使用变体很容易。

Sub R_AnalysisMerger() 
    Dim WSA As Worksheet 
    Dim bookList As Workbook 
    Dim SelectedFiles() As Variant 
    Dim NFile As Long 
    Dim FileName As String 
    Dim Ws As Worksheet, vDB As Variant, rngT As Range 

    Application.ScreenUpdating = False 


    Set Ws = ThisWorkbook.Sheets(1) 
    Ws.UsedRange.Clear 
    'change folder path of excel files here 
    SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.csv*), *.csv*", MultiSelect:=True) 


    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles) 
     FileName = SelectedFiles(NFile) 
     Set bookList = Workbooks.Open(FileName, Format:=2) 
     Set WSA = bookList.Sheets(1) 
     With WSA 
      vDB = .UsedRange 
      Set rngT = Ws.Range("a" & Rows.Count).End(xlUp)(2) 
      If rngT.Row = 2 Then Set rngT = Ws.Range("a1") 
      rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB 

      bookList.Close (0) 
     End With 
    Next 
    Application.ScreenUpdating = True 
    Ws.Range("A1").Select 

End Sub 

另一个是

Sub R_AnalysisMerger2() 
    Dim WSA As Worksheet 
    Dim bookList As Workbook 
    Dim SelectedFiles As Variant 
    Dim NFile As Long 
    Dim FileName As String 
    Dim Ws As Worksheet, vDB As Variant, rngT As Range 
    Dim vFn, myFn As String 

    Application.ScreenUpdating = False 

    SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.csv*), *.csv*", MultiSelect:=True) 
    If IsEmpty(SelectedFilesL) Then Exit Sub 

    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles) 
     FileName = SelectedFiles(NFile) 
     vFn = Split(FileName, "\") 
     myFn = vFn(UBound(vFn)) 
     myFn = Replace(myFn, ".csv", "") 
     Set bookList = Workbooks.Open(FileName, Format:=2) 
     Set WSA = bookList.Sheets(1) 
     vDB = WSA.UsedRange 
     bookList.Close (0) 
     Set Ws = Sheets.Add(after:=Sheets(Sheets.Count)) 
     ActiveSheet.Name = myFn 
     Ws.Range("a1").Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB 
    Next 
    Application.ScreenUpdating = True 


End Sub