将多个csv文件合并到一个excel工作表中

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

工作守则是：

---

将工作文件分为单独的工作表

子示例12（）
将MyPath设置为字符串
将文件输入路径设置为字符串
将MyFiles（）设置为字符串
暗源计数等于长
模糊的Fnum与长的Fnum一样
将mybook设置为工作簿
作为工作簿的Dim basebook
'填写文件所在的路径\文件夹
“在你的机器上
MyPath=“c:\Data”
'如果用户忘记了，请在末尾添加斜杠
如果正确（MyPath，1）“\”则
MyPath=MyPath&“\”
如果结束
'如果文件夹中没有Excel文件，请退出子文件夹
FilesInPath=Dir（MyPath&“*.csv”）
如果FilesInPath=“”，则
MsgBox“未找到任何文件”
出口接头
如果结束
关于错误转到清理
Application.ScreenUpdating=False
设置basebook=ThisWorkbook
'用文件夹中的Excel文件列表填充数组（myFiles）
Fnum=0
在文件输入路径“”时执行此操作
Fnum=Fnum+1
ReDim保留我的文件（1到Fnum）
MyFiles（Fnum）=FilesInPath
FilesInPath=Dir（）
环
'循环遍历数组中的所有文件（myFiles）
如果Fnum>0，则
对于Fnum=LBound（MyFiles）到UBound（MyFiles）
设置mybook=Workbooks.Open（MyPath&MyFiles（Fnum））
mybook.工作表（1）.在以下时间后复制：_
basebook.Sheets（basebook.Sheets.Count）
出错时继续下一步
ActiveSheet.Name=mybook.Name
错误转到0
'如果只想复制值，可以使用此选项
'使用ActiveSheet.UsedRange
'.Value=.Value
"以
mybook.Close savechanges:=False
下一个Fnum
如果结束
清理：
Application.ScreenUpdating=True
端接头
---------------------------------------------------------
但我所做的更改是，将VBA将其复制到上一张工作表“之后”的部分更改为将其附加到现有工作表“Totaal”。

---

不工作的代码
---------------------------------------------------------
子示例12（）
将MyPath设置为字符串
将文件输入路径设置为字符串
将MyFiles（）设置为字符串
暗源计数等于长
模糊的Fnum与长的Fnum一样
将mybook设置为工作簿
作为工作簿的Dim basebook
'填写文件所在的路径\文件夹
“在你的机器上
MyPath=“c:\Data”
'如果用户忘记了，请在末尾添加斜杠
如果正确（MyPath，1）“\”则
MyPath=MyPath&“\”
如果结束
'如果文件夹中没有Excel文件，请退出子文件夹
FilesInPath=Dir（MyPath&“*.csv”）
如果FilesInPath=“”，则
MsgBox“未找到任何文件”
出口接头
如果结束
关于错误转到清理
Application.ScreenUpdating=False
设置basebook=ThisWorkbook
'用文件夹中的Excel文件列表填充数组（myFiles）
Fnum=0
在文件输入路径“”时执行此操作
Fnum=Fnum+1
ReDim保留我的文件（1到Fnum）
MyFiles（Fnum）=FilesInPath
FilesInPath=Dir（）
环
'循环遍历数组中的所有文件（myFiles）
如果Fnum>0，则
对于Fnum=LBound（MyFiles）到UBound（MyFiles）
设置mybook=Workbooks.Open（MyPath&MyFiles（Fnum））
我的书。工作表（1）。复印件
**basebook.Sheets（“Totaal”）。选择
NextRow=单元格（Rows.Count，0）.End（xlUp）.Row
单元格（下一步，1）。选择
活动表。粘贴**
出错时继续下一步
ActiveSheet.Name=mybook.Name
错误转到0
'如果只想复制值，可以使用此选项
'使用ActiveSheet.UsedRange.Value=.Value
"以
mybook.Close savechanges:=False
下一个Fnum
如果结束
清理：
Application.ScreenUpdating=True
端接头

---

我没有知识来改变这个：（。 我走对了吗

所有的意见都将不胜感激

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

---

谢谢！

要导入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

---

在

Set basebook=此工作簿之后

输入以下内容：

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

下面是校正后的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

这些更改后，它不起作用。它只打开1张工作表并删除整个工作表。使用调试器；按F8单步执行代码并查看哪些不起作用。使用Debug.Print查看变量。我知道您只需要一张工作表。而且它不删除整个工作表；它只是重命名它。如果您不想这样做，请删除它那一行。谢谢你的回复。我明天会检查这一行。我确实想将所有csv文件合并到一张工作表中。但在这种情况下，他导入了一张csv，将工作表从Total重命名为csv文件的名称，然后停止了。明天我有更多的时间时，我会深入其中！再次感谢你的回复！我注释掉了这一行代码。T整个过程进行得很顺利！！'你真的想更改工作表名称吗？.name=mybook.name我将对此进行研究..这看起来是一个更好的解决方案，但我现在不知道如何在我的代码中实现这一点。
Dim nextRow As Integer
Dim wsTotal As Worksheet
Set wsTotal = basebook.Worksheets("Total")

'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