vba 在一张 Excel 表格中合并多个 csv 文件

Merge multiple csv files in one excel sheet

提问by Peter O

After searching a lot on the internet i tried to combine a working Excel VBA code that reads all .csv files in a folder into an excel file (each on a seperate worksheet). But the only thing i need is to combine all the csv files in 1 worksheet....

在互联网上搜索了很多之后，我尝试将一个工作 Excel VBA 代码组合起来，该代码将一个文件夹中的所有 .csv 文件读取到一个 excel 文件中（每个都在一个单独的工作表上）。但我唯一需要的是将所有 csv 文件合并在 1 个工作表中....

The working code is:

工作代码是：

---

---

working file into seperate worksheets

工作文件到单独的工作表

Sub Example12()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook

'Fill in the path\folder where the files are
'on your machine
MyPath = "c:\Data"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.csv")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp

Application.ScreenUpdating = False
Set basebook = ThisWorkbook

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
mybook.Worksheets(1).Copy after:= _
basebook.Sheets(basebook.Sheets.Count)

On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0

' You can use this if you want to copy only the values
' With ActiveSheet.UsedRange
' .Value = .Value
' End With

mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub
---------------------------------------------------------

But the change i've made was to change the part where the VBA copies it into a sheet "after" the last one, to append it to a existing sheet "Totaal".

---

---

not working code
---------------------------------------------------------

Sub Example12()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook

'Fill in the path\folder where the files are
'on your machine
MyPath = "c:\Data"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.csv")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp

Application.ScreenUpdating = False
Set basebook = ThisWorkbook

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
mybook.Worksheets(1).Copy

**basebook.Sheets("Totaal").Select
NextRow = Cells(Rows.Count, 0).End(xlUp).Row
Cells(NextRow, 1).Select
ActiveSheet.Paste**

On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0

' You can use this if you want to copy only the values
' With ActiveSheet.UsedRange.Value = .Value
' End With

mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub

---

---

I haven't got the knowledge to change this :(. Was I on the right track?

我没有知识来改变这一点:(。我是在正确的轨道上吗？

All input will be greatly appreciated!

所有输入将不胜感激！

EXTRA INFO: The data in the CSV files are put in the first column. After the whole merging process i planned to do the split into columns afterwards....

额外信息：CSV 文件中的数据放在第一列中。在整个合并过程之后，我计划在之后将其拆分为列....

Thanks!

谢谢！

采纳答案by D_Bester

After Set basebook = ThisWorkbook

后 Set basebook = ThisWorkbook

Enter this:

输入这个：

Dim nextRow As Integer
Dim wsTotal As Worksheet
Set wsTotal = basebook.Worksheets("Total")

And here is the corrected For loop:

这是更正的 For 循环：

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
    For Fnum = LBound(MyFiles) To UBound(MyFiles)

        'open file
        Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))

        With wsTotal

            'activate if you want (optional)
            '.Activate

            'copy all the data on the sheet
            mybook.Worksheets(1).UsedRange.Copy

            'find the next empty row
            nextRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1

            'select if desired (optional)
            '.Cells(NextRow, 1).Select

            'paste the data
            .Cells(nextRow, 1).PasteSpecial (xlPasteAll)

            'turn off copy mode
            Application.CutCopyMode = False

            'Do you really want to change the worksheet name?
            .Name = mybook.Name
        End With

        'close file
        mybook.Close savechanges:=False

    Next Fnum

回答by d-stroyer

To import csv files I would suggest using a query instead of opening them. This way, you can also perform the data-to-columns split on-the-go :

要导入 csv 文件，我建议使用查询而不是打开它们。这样，您还可以随时随地执行数据到列的拆分：

Sub ImportToNewWorksheet(ImpFileName as String)
 Dim mySheet As Worksheet
 Set mySheet = ThisWorkbook.Worksheets.Add
 Call ImportFile(ImpFileName, mySheet.Cells(1,1))
End Sub

Sub ImportFile(ImpFileName As String, ImpDest As Range)
 With ImpDest.Worksheet.QueryTables.Add(Connection:= _
  "TEXT;" & ImpFileName, Destination:=ImpDest)
  .Name = "Import"
  .FieldNames = True
  .RowNumbers = False
  .FillAdjacentFormulas = False
  .PreserveFormatting = True
  .RefreshOnFileOpen = False
  .RefreshStyle = xlOverwriteCells
  .SavePassword = False
  .SaveData = True
  .AdjustColumnWidth = True
  .RefreshPeriod = 0
  .TextFilePromptOnRefresh = False
  .TextFilePlatform = 65001
  .TextFileStartRow = 1
  .TextFileParseType = xlDelimited
  .TextFileTextQualifier = xlTextQualifierDoubleQuote
  .TextFileConsecutiveDelimiter = False
  .TextFileTabDelimiter = False
  .TextFileSemicolonDelimiter = False
  .TextFileCommaDelimiter = True
  .TextFileSpaceDelimiter = False
  .TextFileColumnDataTypes = Array(1, 1, 1, 1)
  .TextFileTrailingMinusNumbers = True
  .Refresh BackgroundQuery:=False
 End With

End Sub