import multiple text files to seperate sheets in t

问题:

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.

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.

Solution

I modified the lines from

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

to

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

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.

Please help me to solve this problem.

Here is my code with changes

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

回答1:

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

change

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

to

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

and get rid of wkbTemp variable at all

---

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

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