导入多个文本文件来分离现有工作簿中的工作表

我有一个Excel文件（2013）（例如test.xlsm ）。 excel文件包含图表和基于文本文件每月刷新的数据透视表。 我需要一个VBA代码，可以从我的本地驱动器（我从服务器导入）导入多个文本文件，并将其附加在这个Excel文件的末尾（名为类似于文本文件名称的工作表）。 每个月，当我input文本文件时，都必须用新文件replace这个数据表。

问题：
我在这个链接中find了一个VBA代码！ 它工作得很好。 但我的问题是它将数据导入新打开的工作簿，而不是现有的工作簿。

解

我修改了从

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

至

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

但是我得到错误1004，没有select数据格式的数据与分隔符

 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:="|" 

解决scheme我发现了一些类似于我的问题（比如这个问题 ），但是他们都没有为我工作。

请帮我解决这个问题。

这是我的代码与更改

 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摆脱wkbTempvariables

---

如果您需要将数据复制到同一工作簿的现有工作表中，请replace

 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