将多个文本文件导入现有工作簿中的单独工作表

Question

我有一个 excel 文件 (2013)（例如 test.xlsm）。 excel 文件包含带有图表和数据透视表的表格，这些表格基于文本文件每月刷新一次。我需要一个 VBA 代码，它可以从我的本地驱动器（我从服务器导入）导入多个文本文件，并将它们附加到这个 excel 文件的末尾（类似于文本文件名的工作表）。每个月，当我导入文本文件时，它必须用新文件替换此数据表。

问题：
我在link 中找到了 VBA 代码！它工作得很好。但我的问题是将数据导入新打开的工作簿而不是现有工作簿。

解决方案

我修改了

Set wkbAll = ActiveWorkbook
wkbTemp.Sheets(1).Copy

到

Set wkbAll = ThisWorkbook
wkbAll.Activate
wkbTemp.Sheets(1).Copy After:=Sheets(wkbAll.Sheets.Count)

但我得到 错误 1004，未选择数据用分隔符格式化数据

wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
    Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=False, Semicolon:=False, _
    Comma:=False, Space:=False, _
    Other:=True, OtherChar:="|"

解决方案 我发现了一些与我类似的问题（如this one），但没有一个对我有用。

请帮我解决这个问题。

这是我的更改代码

Sub copydata()

    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim sDelimiter As String


    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    sDelimiter = "|"

    FilesToOpen = Application.GetOpenFilename _
        (FileFilter:="Text Files (*.txt), *.txt", _
        MultiSelect:=True, Title:="Text Files to Open")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If


    Set wkbAll = Application.ActiveWorkbook
    x = 1

    With Workbooks.Open(fileName:=FilesToOpen(x))
        .Worksheets(1).Columns("A:A").TextToColumns _
            Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
            Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
            Other:=True, OtherChar:="|"
        .Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count)
        .Close False
    End With

    x = x + 1

    While x <= UBound(FilesToOpen)
        With Workbooks.Open(fileName:=FilesToOpen(x))
            .Worksheets(1).Columns("A:A").TextToColumns _
                Destination:=Range("A1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, _
                ConsecutiveDelimiter:=False, _
                Tab:=False, Semicolon:=False, _
                Comma:=False, Space:=False, _
                Other:=True, OtherChar:=sDelimiter
            .Sheets(1).Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count)

        End With
        x = x + 1
    Wend

    wkbAll.Save
ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

Answer 1

在 OP 提出新请求后编辑（见答案底部）

改变

wkbTemp.Sheets(1).Copy After:=Sheets(wkbAll.Sheets.Count)

到

wkbTemp.Sheets(1).Copy After:=wkbAll.Sheets(wkbAll.Sheets.Count)

因此您也可以更改整个部分：

Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
Set wkbAll = ThisWorkbook
wkbAll.Activate
wkbTemp.Sheets(1).Copy After:=Sheets(wkbAll.Sheets.Count)
wkbTemp.Close (False)

到

With Workbooks.Open(Filename:=FilesToOpen(x))
    .Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count)
    .Close False
End With

并完全摆脱 wkbTemp 变量

---

您是否需要将数据复制到同一工作簿的现有工作表中，然后替换

With Workbooks.Open(Filename:=FilesToOpen(x))
    .Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count)
    .Close False
End With

与

With Worksheets("Data1") '<--| change "Data1" to your actual name of existing sheet where to paste data into
    .UsedRange.ClearContents
    Worksheets(1).UsedRange.Copy .Range("A1")
End With