Разделите файл Excel на несколько файлов с разделителями табуляции, и он должен получить заголовок для каждого файла разделения с листа 2

У меня есть требование, где у меня есть файл Excel с 400 записями. Я должен разделить файл Excel на несколько текстовых файлов с разделителями табуляции, каждый из которых содержит 50 записей. Прикрепленный файл Excel содержит сведения об имени столбца на листе 2, а на листе 1 данные доступны.

Код 1:

Sub SplitData()
Dim WorkRng As Range
Dim xRow As Range
Dim SplitRow As Integer
Dim xWs As Worksheet
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
SplitRow = Application.InputBox("Split Row Num", xTitleId, 1000, Type:=1)
Set xWs = WorkRng.Parent
Set xRow = WorkRng.Rows(1)
Application.ScreenUpdating = False
For i = 1 To WorkRng.Rows.Count Step SplitRow
    resizeCount = SplitRow
    If (WorkRng.Rows.Count - xRow.Row + 1) < SplitRow Then resizeCount = WorkRng.Rows.Count - xRow.Row + 1
    xRow.Resize(resizeCount).Copy
    Application.Worksheets.Add after:=Application.Worksheets(Application.Worksheets.Count)
    Application.ActiveSheet.Range("A1").PasteSpecial
    Set xRow = xRow.Offset(SplitRow)
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Код 2:

Public Sub CharacterSV()
        Const DELIMITER As String = vbTab
        Dim myRecord As Range
        Dim myField As Range
        Dim nFileNum As Long
        Dim sOut, NewFileName, d As String
        Dim row_Current, column_Current As Integer
        Dim activeRows, activeColumns As Integer

        activeRows = Cells.CurrentRegion.Rows.Count
        activeColumns = Cells.CurrentRegion.Columns.Count

        row_Current = column_Current = 1
        nFileNum = FreeFile

       ' NewFileName = InputBox(Prompt:="Kindly Enter the File name", _
        '  Title:="ENTER File Name", Default:="")

NewFileName = ThisWorkbook.Name
        NewFileName = Replace(NewFileName, ".xlsx", "")

        Open ThisWorkbook.Path & "\" & NewFileName & ".txt" For Output As #nFileNum
        For Each myRecord In Range("A1:A" & _
                    Range("A" & Rows.Count).End(xlUp).Row)
                 With myRecord
                    row_Current = row_Current + 1
                    column_Current = 0
                    For Each myField In Range(.Cells, _
                        Cells(.Row, Columns.Count).End(xlToLeft))
                    column_Current = column_Current + 1
                  ' MsgBox "Cell " & Replace("Shopping", "o", "i")
                    d = myField.Text
                  Do While (InStr(d, vbCr) > 0)
                   d = Replace(d, "" + vbCr, " ")
                  Loop

                  Do While (InStr(d, vbTab) > 0)
                   d = Replace(d, "" + vbTab, " ")
                  Loop

                  Do While (InStr(d, vbCrLf) > 0)
                   d = Replace(d, "" + vbCrLf, " ")
                  Loop

                  Do While (InStr(d, vbLf) > 0)
                   d = Replace(d, "" + vbLf, " ")
                  Loop

                   d = Trim(d)
                   Do While (InStr(d, "  ") > 0)
                   d = Replace(d, "  ", " ")
                   Loop
                    sOut = sOut & DELIMITER & d
                    'i = sOut.

                Next myField
                If (column_Current = activeColumns And row_Current = activeRows) Then
                    Print #nFileNum, Mid(sOut, 2);
                Else
                    Print #nFileNum, Mid(sOut, 2)
                End If

                sOut = Empty
            End With
        Next myRecord
        Close #nFileNum
        MsgBox "Done :)"
End Sub