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

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