导入多个文本文件以分离现有工作簿中的工作表 [英] import multiple text files to seperate sheets in the existing workbook

问题描述

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

I have an excel file (2013) (eg test.xlsm). The excel file contains sheets with graphs and pivot tables which are refreshed monthly, based on text files. I need a VBA code which can import multiple text files from my local drive (which I import from a server) and append them at the end (sheets named similar to text file names) in this excel file. Every month, when I import text files, it has to replace this data sheets with new files.

问题：

我在这个链接中找到了VBA代码！它工作完好无损。但是我的问题是将数据导入新打开的Workbook而不是现有的Workbook。

Problem:
I have found a VBA code in this link! It works perfectly fine. But my problem is it imports the data into a newly opened Workbook instead of existing Workbook.

解决方案

我修改了

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

to

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

但是我得到错误1004，没有数据选择格式化数据与分隔符

but I get error 1004, no data selected to format the data with delimiter

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

解决方案
我发现了一些类似于我的问题（如这一个 ），但没有一个为我工作。

Solution I have found the some questions similar to mine (like this one), but none of them worked for me.

请帮我解决这个问题。

我的代码与更改

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

推荐答案

在OP的新请求之后编辑（见答案底部）

edited after OP's new request (see bottom of the answer)

更改

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

到

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

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

thus you can also change the whole section:

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

to

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

并摆脱 wkbTemp 所有变量

如果您需要将数据复制到现在的工作表，然后替代

should you need to copy data into an existing worksheet of the same workbook, then substitute

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

这篇关于导入多个文本文件以分离现有工作簿中的工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！