try this code

i attached excel file

[vba]
trows = Range("a65536").End(xlUp).Row
Dim yes As Boolean
Dim pid As Integer
Dim tprid(), cprid(1 To 10000), twb() As Variant
ReDim tprid(1 To trows) As Variant
yes = False
pid = 1

For i = 2 To trows
If Cells(i, 16).Value <> "" Then
tprid(pid) = Cells(i, 16).Value
Else
tprid(pid) = Cells(i, 6).Value
End If
pid = pid + 1
Next i

pid = 1

For td = 1 To trows
tda = tprid(td)
For cd = 1 To pid
ttda = cprid(cd)
If tda = ttda Then yes = True
Next cd
If yes = False Then
cprid(pid) = tda
pid = pid + 1
End If
yes = False
Next td

ReDim twb(1 To pid - 1) As Variant

Dim fodr As FileDialog
Dim npas As Integer
Dim yespr As Boolean

yespr = False

npas = 3

Set fodr = Application.FileDialog(msoFileDialogFolderPicker)

fodr.Title = "BROWSE FOLDER FOR SAVE EXCEL FILES"

If fodr.Show = -1 Then get_path = fodr.SelectedItems(1)

For final = 1 To pid - 1

wbname = cprid(final) & ".xls"
Set twb(final) = Workbooks.Add
twb(final).Title = wbname
twb(final).SaveAs Filename:=get_path & "\" & wbname & ".xls"

For filpr = 2 To trows
If cprid(final) = Workbooks("sample (1)").Sheets(1).Cells(filpr, 16).Value Then
Workbooks(wbname).Sheets(1).Cells(1, 1).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 6).Value
Workbooks(wbname).Sheets(1).Cells(1, 2).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 15).Value
Workbooks(wbname).Sheets(1).Cells(1, 3).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 16).Value
Workbooks(wbname).Sheets(1).Cells(1, 4).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 17).Value
Workbooks(wbname).Sheets(1).Cells(1, 5).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 18).Value

Workbooks(wbname).Sheets(1).Cells(npas, 1).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 7).Value
Workbooks(wbname).Sheets(1).Cells(npas, 2).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 8).Value
Workbooks(wbname).Sheets(1).Cells(npas, 3).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 9).Value
Workbooks(wbname).Sheets(1).Cells(npas, 4).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 10).Value
Workbooks(wbname).Sheets(1).Cells(npas, 5).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 12).Value
Workbooks(wbname).Sheets(1).Cells(npas, 6).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 13).Value
Workbooks(wbname).Sheets(1).Cells(npas, 7).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 14).Value
npas = npas + 1
yespr = True
End If
Next filpr

If yespr = False Then
For filpr2 = 2 To trows
If cprid(final) = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 6).Value Then
Workbooks(wbname).Sheets(1).Cells(1, 1).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 6).Value
Workbooks(wbname).Sheets(1).Cells(1, 2).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 15).Value
Workbooks(wbname).Sheets(1).Cells(1, 3).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 16).Value
Workbooks(wbname).Sheets(1).Cells(1, 4).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 17).Value
Workbooks(wbname).Sheets(1).Cells(1, 5).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 18).Value

Workbooks(wbname).Sheets(1).Cells(npas, 1).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 7).Value
Workbooks(wbname).Sheets(1).Cells(npas, 2).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 8).Value
Workbooks(wbname).Sheets(1).Cells(npas, 3).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 9).Value
Workbooks(wbname).Sheets(1).Cells(npas, 4).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 10).Value
Workbooks(wbname).Sheets(1).Cells(npas, 5).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 12).Value
Workbooks(wbname).Sheets(1).Cells(npas, 6).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 13).Value
Workbooks(wbname).Sheets(1).Cells(npas, 7).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 14).Value
npas = npas + 1
End If
Next filpr2
End If

Workbooks(wbname).Save
Workbooks(wbname).Close
yespr = False
npas = 3

Next final

[/vba]