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

我试图拉入选定的一组.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