Copy text files into separate worksheets in Excel

I need to have my code below modified to have 1 to several text files copied and pasted into different sheets in a template workbook. Each text file will list an aquisition ID in the first column which will be all the same for that text file. I need that text with aq ID copied and pasted into the template file in a new worksheet with that aq ID as the tab name. There can be 1 to several text files that I need this done for. The naming convention for the text files are r99997_1_n.txt with the n being a different number (r99997_1_1.txt, r99997_1_2.txt, r99997_1_3.txt,.....) All of the texts with that naming convention needs to be copied over to excel.

My orig code when I thought the aquisition IDs were going to be in 1 text file:
Dim stPath As String
Dim stText As String
Dim stTemp As String

stPath = "H:\"
stText = "r99997_1_1.txt"
stTemp = "Template Report ACQ Result.xlsx"

Workbooks.Open Filename:=stPath & "Templates\" & stTemp
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;H:\" & stText, Destination:=Range("$A$7"))
        .Name = stText
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

 Dim rCheck As Range
    Dim rFilter As Range
    Dim cUnique As New Collection
    Dim i As Long
    Dim CurrentCell As Range
    Dim wsTarget As Worksheet
    Dim dtRpt As Date
    Dim wsOrig As Worksheet
 
   
    Set wsOrig = Worksheets("Loan Level")
    dtRpt = Date
     
    With wsOrig
    .Range("A1").Value = dtRpt
        Set rCheck = .Range(.Cells(6, "A"), .Cells(.rows.Count, "A").End(xlUp))
        Set rFilter = .Range(.Cells(7, "A"), .Cells(.rows.Count, "A").End(xlUp))
        On Error Resume Next
        For Each CurrentCell In rFilter.Cells
            cUnique.Add CurrentCell.Value, CurrentCell.Value
        Next CurrentCell
        On Error GoTo 0
    End With
   
    For i = 1 To cUnique.Count
       
           Set wsTarget = Workbooks(stTemp).Sheets.Add(After:=Sheets(Sheets.Count))
            On Error Resume Next
            wsTarget.Name = cUnique(i)
            If Err.Number <> 0 Then
                Err.Clear
            End If

wsOrig.rows("1:6").Copy
wsTarget.Range("A1").PasteSpecial xlPasteAllUsingSourceTheme
        wsTarget.Range("A1").PasteSpecial xlPasteColumnWidths
             
        wsOrig.Shapes.Range(Array("Picture 2")).Copy
        wsTarget.Paste

       ActiveWindow.DisplayGridlines = False
    Range("A1").Select
            rCheck.AutoFilter Field:=1, Criteria1:=cUnique(i)
            rFilter.SpecialCells(xlCellTypeVisible).EntireRow.Copy wsTarget.rows(7)
            rCheck.Parent.AutoFilterMode = False

        On Error GoTo 0
               
    Next i
   
   Sheets("Loan Level").Delete
       Sheets("Criteria").Move After:=Sheets(Sheets.Count)
        Worksheets(1).Select
   Workbooks(stTemp).SaveAs stPath & "ACQ Call Result " & Format(dtRpt, "mmddyy") & ".xlsx"
   ActiveWorkbook.Close
DCUnitedAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Robberbaron (robr)Commented:
dont have anything to test against...

but i have broken down the first part into a couple of routines; see how they work for you

Option Explicit
Sub MakeSheets()
    
    Dim stPath As String
    Dim stText As String
    Dim stTemp As String
    Dim fl As String, aqId As String
    
    stPath = "H:\" & "Templates\"
    stText = "r99997_1_*.txt"
    
    stTemp = "Template Report ACQ Result.xlsx"
    
    Dim wbActive As Workbook, wsTemplate As Worksheet
    Dim wsActive As Worksheet
    
    Set wbActive = Workbooks.Open(Filename:=stPath & fl)
    
    'assume that the template is active sheet.  better to name it
    Set wsTemplate = wbActive.ActiveSheet

    
    fl = Dir$(stText)
    'find all matching files
    Do While fl <> ""
        'create a new sheet from template
        wsTemplate.Copy Before:=wsTemplate
        Set wsActive = wbActive.ActiveSheet  ' the new sheet
        aqId = LoadTxtFile(wsActive, stPath & fl)
        wsActive.Name = aqId
    Loop
    
End Sub
    
Function LoadTxtFile(wsTarget As Worksheet, txtFilename As String) As String

    'Workbooks.Open Filename:=stPath & "Templates\" & stTemp
        'With ActiveSheet.QueryTables.Add(Connection:="TEXT;H:\" & stText, Destination:=Range("$A$7"))
        Dim rngDest As Range
        Set rngDest = Range("$A$7")
        With wsTarget.QueryTables.Add(Connection:="TEXT;" & txtFilename, Destination:=rngDest)
            .Name = stText
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = False
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        
        LoadTxtFile = rngDest.Value   'the acquisition ID
        
End Function

Open in new window

0
DCUnitedAuthor Commented:
It doesn't like the Set wbActive = Workbooks.Open(Filename:=stPath & fl)
Since that line is opening the excel template file, shouldn't it be stTemp & not fl?
0
DCUnitedAuthor Commented:
I was able to get this to work, but it tries to use the same text file and not the next one.
Keeps getting stuck on r99997_1_1.txt and not moving to r99997_1_2.txt & so on.


Dim stPath As String
Dim stTemp As String
Dim stText As String
Dim stFile As String
 Dim wbActive As Workbook, wsTemplate As Worksheet
    Dim wsActive As Worksheet

stPath = "H:\Hermes\"
stText = "r99997_1_*.txt"
stTemp = "Template Report ACQ SPOC Call Result.xlsx"

Set wbActive = Workbooks.Open(Filename:=stPath & "Templates\" & stTemp)
Set wsTemplate = wbActive.ActiveSheet
stFile = Dir$(stPath & stText)


Do While stFile <> ""

wsTemplate.Copy Before:=wsTemplate
        Set wsActive = wbActive.ActiveSheet  ' the new sheet
        aqId = LoadTxtFile(wsActive, stPath & stFile)
        wsActive.Name = aqId

    Loop
   
End Sub


Function LoadTxtFile(wsTarget As Worksheet, txtFilename As String) As String

    'Workbooks.Open Filename:=stPath & "Templates\" & stTemp
        'With ActiveSheet.QueryTables.Add(Connection:="TEXT;H:\" & stText, Destination:=Range("$A$7"))
        Dim rngDest As Range
        Set rngDest = Range("$A$7")
        With wsTarget.QueryTables.Add(Connection:="TEXT;" & txtFilename, Destination:=rngDest)
            .Name = stText
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = False
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery = False
        End With
       
        LoadTxtFile = rngDest.Value   'the acquisition ID
0
Robberbaron (robr)Commented:
true on both counts...

you also should post code as an embedded  'code snippet'   use the button </>

Set wbActive = Workbooks.Open(Filename:=stPath & "Templates\" & stTemp)
Set wsTemplate = wbActive.ActiveSheet    '<<< if known , change to wbActive.Sheets("template") or similar.
stFile = Dir$(stPath & stText)


Do While stFile <> ""

       wsTemplate.Copy Before:=wsTemplate
        Set wsActive = wbActive.ActiveSheet  ' the new sheet
        aqId = LoadTxtFile(wsActive, stPath & stFile)
        wsActive.Name = aqId
        stFile = Dir$      '<<<< find next matching file 
    Loop

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
DCUnitedAuthor Commented:
I usually do embed my code or upload them. Not sure why I didn't this time. That 1 little line made all the difference. Thank you so much.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.