VBA to import multiple .txt files to multiple sheets MODIFY EXISTING CODE?

[dlg81]

I need a macro/VBA to import a selection of multiple .txt files into multiple worksheets. When I use the code shown below it works great but it creates a new sheet for each file and uses the imported file name to name the sheet that is created. I need to import the .txt files into pre-existing sheets and retain the original sheet names. For example I'd like to import 10 .txt files into pre-defined sheets named "Part 1", "Part 2", "Part 3"....etc.

I'm not well versed in VBA but I believe the code below could be modified to achieve the described results, any help would be greatly appreciated. Thanks!

Also, I may not need to always import 10 .txt files, sometimes it may be 5 or 2 or even 1, etc. How do I import them in sequential order?

Sub CombineTextFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp 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

    x = 1
    Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x))
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ActiveWorkbook
    wkbTemp.Close (False)
    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:="|"
    x = x + 1

    While x <= UBound(FilesToOpen)
        Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
            .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:=sDelimiter
        End With
        x = x + 1
    Wend

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

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

 

[Rijnsent]

Hi there,
what you describe is very well possible with VBA. Two questions:

• are your files at a certain location, e.g. all files in one directory? Are they the only files in that directory?
• do the files have names that match the part 1, part 2 etc sheet where they should go?

And to get you started: you'll need a loop, see e.g. this page from quite an okay beginners course VBA: VBA Course: Loops

Cheers,
Koen

 

[dlg81]

Hi there,
what you describe is very well possible with VBA. Two questions:

• are your files at a certain location, e.g. all files in one directory? Are they the only files in that directory?
• do the files have names that match the part 1, part 2 etc sheet where they should go?

And to get you started: you'll need a loop, see e.g. this page from quite an okay beginners course VBA: VBA Course: Loops

Cheers,
Koen

Thanks for your response!

• There will be many files in the directory I'm looking to pull the data from so I will need the ability to select which files I need to pull into the worksheet.
• The files will not have the same names as the sheet I need to pull them into.

I will check out the link for VBA Course: Loops, thanks for the suggestion!

 

[Rijnsent]

Okay, I don't know how you will determine where to paste the data (which file goes to which sheet), but something like this should work to import the data of multiple files and copy-paste it on one sheet, "Part 1" (left out the text-to-columns):

Sub CombineTextFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    Set ActiveWb = ActiveWorkbook
    Set DestSht = ActiveWb.Worksheets("Part 1")
    DestSht.Cells.ClearContents
    
    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

    x = 1
    For x = 1 To UBound(FilesToOpen)
        Debug.Print FilesToOpen(x)
        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
        Set Sht = wkbTemp.Sheets(1)
        Debug.Print Sht.UsedRange.Address
        
        'Where to paste: go to the bottom of the sheet, go up (ctrl+up) and shift 1 cell down
        Set PasteRange = DestSht.Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0)
        
        Sht.UsedRange.Copy
        PasteRange.PasteSpecial xlValues
        Application.CutCopyMode = False 'empty clipboard
        
        wkbTemp.Close
    Next x

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

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub