Need to create unique .txt files from selected number of rows

[eq52515]

Please excuse the long post.

My task is to create unique txt files from a selected number of rows of data. I later import a txt file into a pdf form and print the completed form. If I have 15 rows of data selected, I would need to have 15 unique txt files saved in a specified location.

This is sample of the data:
[TABLE="width: 1264"]
<tbody>[TR]
[TD]Storage Bin[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Product[/TD]
[TD]Vendor Batch[/TD]
[TD]Owner[/TD]
[TD]Code[/TD]
[TD]Batch[/TD]
[TD]Quantity[/TD]
[TD]Storage Type[/TD]
[TD][/TD]
[TD]Product Short Description[/TD]
[TD]UoM[/TD]
[TD]Inspection Date[/TD]
[TD]DoM[/TD]
[TD]DoE[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]50340AAAHH[/TD]
[TD]A[/TD]
[TD]HH[/TD]
[TD]AA[/TD]
[TD]015365416[/TD]
[TD]ABD09E002095[/TD]
[TD]4302[/TD]
[TD]J[/TD]
[TD]J9-4447773[/TD]
[TD]70[/TD]
[TD]ECDE[/TD]
[TD][/TD]
[TD]OVERBOOT,LIGHTWEIGH[/TD]
[TD]PR[/TD]
[TD]5/30/2019[/TD]
[TD]5/1/2009[/TD]
[TD]5/1/2014[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I currently have a macro to do this for a single line of data, but I need to modify for multiple lines. The single line macro names the txt file by combining the first 13 characters of the Prod description and the first 14 of the vendor batch, this was fine until I have multiples of the same info, only in different locations. I believe that CONCATENTATE has a 30 char limit or I could add on to the end of the file name.

There is a lot of formatting going on, and not the cleanest in the world, but most of this is self taught.
This is my current macro:

Sub Bldg_Tags()
'
' Bldg_Tag Macro
'
'
    
'    ActiveSheet.Name = Range("C5").Value
    
    Selection.Copy
    ActiveSheet.Next.Select
    ActiveSheet.Paste
        
    Sheets.Add After:=ActiveSheet
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Condition Code"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Inspection Activity"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Item Description"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Lot Number"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "NSN or Part Number"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Next Inspection Due / Overage Date"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Quantity"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Unit of Issue"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Remarks"
    Range("A2").Select
    ActiveSheet.Previous.Select
    Range("H3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "MMQ"
    Range("C2").Select
    ActiveSheet.Previous.Select
    Range("M3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D2").Select
    ActiveSheet.Previous.Select
    Range("F3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E2").Select
    ActiveSheet.Previous.Select
    Range("E3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F2").Select
    ActiveSheet.Previous.Select
    Range("O3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    ActiveSheet.Paste
    
    Range("F2").Select
    Selection.NumberFormat = "mmm-yyyy"
    
    Range("G2").Select
    ActiveSheet.Previous.Select
    Range("J3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H2").Select
    ActiveSheet.Previous.Select
    Range("N3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("D6").Select
    ActiveCell.FormulaR1C1 = "=LEFT(R[-4]C[-1],13)"
    Range("E6").Select
    ActiveCell.FormulaR1C1 = "=LEFT(R[-4]C[-1],14)"
    Range("D8:E8").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-2]C,"" - "",R[-2]C[1])"

    ActiveSheet.Name = Range("D8").Value
    
    Range("H6").Select
    ActiveSheet.Previous.Select
    Range("A1").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("H7").Select
    ActiveSheet.Previous.Select
    Range("B3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("H8").Select
    ActiveSheet.Previous.Select
    Range("C3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
    Range("H9").Select
    ActiveSheet.Previous.Select
    Range("D3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            
    Select Case Range("A2").Value
    Case "A", "B", "C"
        Range("H10").Value = "Visually serviceable material, suitable for storage."
    Case Else
        'Do Nothing
    End Select
    
    Range("H11").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C, "" - "", R[-5]C, "" - "", R[-4]C, "" - "", R[-3]C, R[-2]C)"

    Range("H11").Select
    Selection.Copy
    Range("I2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D4:I11").Select
    Selection.ClearContents
    
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
        
' Text_File_Save Macro

    Dim promptSheetInfo As String
    Dim selSheetNum As Integer
    Dim i As Integer
    Dim folderPath As String

' if there exists muti sheets, select one to export

    If Application.Worksheets.Count > 2 Then

    promptSheetInfo = "There are " & Application.Worksheets.Count & " sheets.  Please select one to export:" & Chr(13) & Chr(10)

    For Each eachSheet In Application.Worksheets
        i = i + 1
        promptSheetInfo = promptSheetInfo & i & ": " & eachSheet.Name & Chr(13) & Chr(10)

    Next eachSheet

' get the selected one

    selSheetNum = InputBox(prompt:=promptSheetInfo, Title:="Please enter a number ", Default:=3)

' activate the sheet

    Application.Sheets(selSheetNum).Activate

    End If

'get the folder for exporting

    folderPath = "V:\Documents\Materiel Tags\Txt data\"

    WS = ActiveSheet.Name
    
'export to text file

    ActiveWorkbook.SaveAs Filename:=folderPath & WS & ".txt", FileFormat:=xlTextMSDOS, CreateBackup:=False
    
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    ActiveWindow.Close
    Application.DisplayAlerts = True
    
'    ActiveSheet.Previous.Select
'    Range("A1").Select
End Sub

Thanks in advance for any advice/help.