@罗恩Rosenfeld谢谢你，这个成功了。现在我只需要把我所有的数据文件都改成. txt。

Sub ImportCSVs()
Dim fPath   As String
Dim fCSV    As String  
Dim wbCSV   As Workbook
Dim wbMST   As Workbook
Dim xFileDialog As FileDialog
Set wbMST = ThisWorkbook
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a folder"
If xFileDialog.Show = -1 Then
fPath = xFileDialog.SelectedItems(1)
End If
fPath = xFileDialog.SelectedItems(1) & "\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
fCSV = Dir(fPath & "\" & "*.txt")
On Error Resume Next
Do While Len(fCSV) > 0
Filename = fPath & fCSV
Workbooks.OpenText Filename:=Filename, DataType:=xlDelimited, Semicolon:=True, DecimalSeparator:=",", Comma:=False

wbMST.Sheets(ActiveSheet.Name).Delete
ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count)
Columns.AutoFit
fCSV = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set wbCSV = Nothing
End Sub

这样如何？

Sub CombineTextFiles()

    Dim xFilesToOpen As Variant
    Dim I As Integer
    Dim xWb As Workbook
    Dim xTempWb As Workbook
    Dim xDelimiter As String
    Dim xScreen As Boolean
    On Error GoTo ErrHandler
    xScreen = Application.ScreenUpdating
    Application.ScreenUpdating = False
    xDelimiter = "|"
    xFilesToOpen = Application.GetOpenFilename("CSV Files (*.csv), *.csv", , "Kutools for Excel", , True)
    If TypeName(xFilesToOpen) = "Boolean" Then
        MsgBox "No files were selected", , ""
        GoTo ExitHandler
    End If
    I = 1
    Set xTempWb = Workbooks.Open(xFilesToOpen(I))
    xTempWb.Sheets(1).Copy
    Set xWb = Application.ActiveWorkbook
    xTempWb.Close False
    xWb.Worksheets(I).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=False, Semicolon:=False, _
      Comma:=False, Space:=False, _
      Other:=True, OtherChar:="|"
    Do While I < UBound(xFilesToOpen)
        I = I + 1
        Set xTempWb = Workbooks.Open(xFilesToOpen(I))
        With xWb
            xTempWb.Sheets(1).Move after:=.Sheets(.Sheets.Count)
            .Worksheets(I).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=False, _
              Tab:=False, Semicolon:=False, _
              Comma:=False, Space:=False, _
              Other:=True, OtherChar:=xDelimiter
        End With
    Loop
ExitHandler:
    Application.ScreenUpdating = xScreen
    Set xWb = Nothing
    Set xTempWb = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Description, , "Excel"
    Resume ExitHandler
End Sub