seperate duplicated entries into multiple worksheets/files

I am a novice excel user. any help would be appreciated.

I have a dozen of files. They contains thousands of records. The fourth column of each file is the 'name' column. Each entry of the name has the same number of duplicates (3~6 depending on the file) in that column. I need to separate the rows with those names into deferent files or worksheets for subsequence analysis. For example: first rows of 'record 1', 'record 2', ..., will be exported to one file/worksheet; second appearance of rows with 'record 1', 'record 2', ..., will be exported into the another file/worksheet; and so on.

I don't want to do it manually, there are too many records.

Can it be done?

Thanks a lot!

This look achievable by macro - can you provide an example file?

This code should help. Paste it into a module sheet in the VBA editor (Alt F11)

You will need to list the files containing your data including full path in column A starting in the first row. The output files will be created in the same folder as the input files.

Sub SplitData()
Dim FileLine As String
Dim ValueArray()
Close
FileNumber = FreeFile()
FileNumber1 = FileNumber + 1
FileNumber2 = FileNumber + 2
FileNumber3 = FileNumber + 3
FileNumber4 = FileNumber + 4
FileNumber5 = FileNumber + 5
FileNumber6 = FileNumber + 6

For N = 1 To Cells(65536, 1).End(xlUp).Row
    Erase ValueArray
    ReDim ValueArray(2, 0)
    Open Cells(N, 1) For Input As #FileNumber
    Open Left(Cells(N, 1), Len(Cells(N, 1)) - 4) & " 1.txt" For Output As #FileNumber1
    Open Left(Cells(N, 1), Len(Cells(N, 1)) - 4) & " 2.txt" For Output As #FileNumber2
    Open Left(Cells(N, 1), Len(Cells(N, 1)) - 4) & " 3.txt" For Output As #FileNumber3
    Open Left(Cells(N, 1), Len(Cells(N, 1)) - 4) & " 4.txt" For Output As #FileNumber4
    Open Left(Cells(N, 1), Len(Cells(N, 1)) - 4) & " 5.txt" For Output As #FileNumber5
    Open Left(Cells(N, 1), Len(Cells(N, 1)) - 4) & " 6.txt" For Output As #FileNumber6
        
    Do While Not EOF(FileNumber)
        Line Input #FileNumber, FileLine
        LineArray = Split(FileLine, Chr$(9))
        If LineArray(3) <> "ID" Then
            NewID = True
            For M = 1 To UBound(ValueArray, 2)
                If LineArray(3) = ValueArray(1, M) Then
                    NewID = False
                    ValueArray(2, M) = ValueArray(2, M) + 1
                    TargetFile = ValueArray(2, M)
                End If
            Next M
            If NewID = True Then
                ReDim Preserve ValueArray(2, UBound(ValueArray, 2) + 1)
                ValueArray(1, UBound(ValueArray, 2)) = LineArray(3)
                ValueArray(2, UBound(ValueArray, 2)) = 1
                TargetFile = 1
            End If
            Select Case TargetFile
                Case Is = 1
                    Print #FileNumber1, FileLine
                Case Is = 2
                    Print #FileNumber2, FileLine
                Case Is = 3
                    Print #FileNumber3, FileLine
                Case Is = 4
                    Print #FileNumber4, FileLine
                Case Is = 5
                    Print #FileNumber5, FileLine
                Case Is = 6
                    Print #FileNumber6, FileLine
            End Select
        Else
            Print #FileNumber1, FileLine
            Print #FileNumber2, FileLine
            Print #FileNumber3, FileLine
            Print #FileNumber4, FileLine
            Print #FileNumber5, FileLine
            Print #FileNumber6, FileLine
        End If
    Loop
    Close #FileNumber
    Close #FileNumber1
    Close #FileNumber2
    Close #FileNumber3
    Close #FileNumber4
    Close #FileNumber5
    Close #FileNumber6
Next N
End Sub

Hope this helps.