Sub СформироватьНовыеКнигиПоСтрокам()
Application.ScreenUpdating = False: Application.DisplayAlerts = False

Dim НоваяКнига As Workbook
Dim ПутьГлавнойКниги, ИмяГлавнойКниги As String
Dim eRow, i As Integer

ПутьГлавнойКниги = ActiveWorkbook.Path & "\"
ИмяГлавнойКниги = ActiveWorkbook.Name
eRow = Workbooks(ИмяГлавнойКниги).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row 'Узнаем последнюю строку в главном файле

    For i = 2 To eRow
        Set НоваяКнига = Workbooks.Add
        НоваяКнига.SaveAs Filename:=ПутьГлавнойКниги & Workbooks(ИмяГлавнойКниги).Worksheets(1).Range("A" & i) & ".xlsx"
        НоваяКнига.Worksheets(1).Name = Workbooks(ИмяГлавнойКниги).Worksheets(1).Range("A" & i)
        
            Workbooks(ИмяГлавнойКниги).Worksheets(1).Range("1:1," & i & ":" & i).Copy
            НоваяКнига.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteAll
            НоваяКнига.Worksheets(1).Rows(1).RowHeight = Workbooks(ИмяГлавнойКниги).Worksheets(1).Rows(1).RowHeight
            НоваяКнига.Worksheets(1).Rows(i).RowHeight = Workbooks(ИмяГлавнойКниги).Worksheets(1).Rows(i).RowHeight
            НоваяКнига.Worksheets(1).Columns("A:A").Delete
            Cells.EntireColumn.AutoFit
            
            Application.CutCopyMode = False
            
        НоваяКнига.Close SaveChanges:=True
    Next i
    
Application.DisplayAlerts = True: Application.ScreenUpdating = True

            MsgBox "Данные скопированны в книги!", vbInformation, "Готово!"
End Sub

Sub Старт()
    Call Module1.ДобавитьВыпадающийСписко(Range("B3"), Range("A6"), ";")
'Где Module1 - это имя модуля в котором лежит "ДобавитьВыпадающийСписко"
'Где Range("B3") - Ячейка со списком.
'Где Range("A4") - Ячейка куда необходимо вставить выпадающий список
'Где ";" - Разделитель, которым разделены данные в ячейке Range("B3")
End Sub

' Добавить в любой модуль
Sub ДобавитьВыпадающийСписко(ЯчейкаСДанными As Range, ЯчейкаКудаВставить As Range, Разделитель As String)
Dim arr As Variant
Dim rng As Range
    
    arr = Split(ЯчейкаСДанными.Value, Разделитель)
        Set rng = ЯчейкаКудаВставить
    
    With rng.Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=Join(arr, ",") ' Указываем тип, формулу validation
        .IgnoreBlank = True ' Игнорируем пустые значения
        .InCellDropdown = True ' Включаем выпадающий список
        .InputTitle = "Заголовок" ' Указываем заголовок для подсказки
        .InputMessage = "Тут сообщение" ' Указываем сообщение для подсказки
        .ShowInput = True ' true - Показываем подсказку при выборе ячейки, false - Скрываем подсказку
        .ErrorTitle = "Заголовок ошибки" ' Указываем заголовок для ошибки (Если в ячеку со списком ввести значение которого нет в списке)
        .ErrorMessage = "Сообщение ошибки" ' Указываем сообщение для ошибки
        .ShowError = True ' true - Показываем ошибку при вводе не верного значения, false - Скрываем ошибку
    End With
End Sub 

=ЕСЛИ(
ИНДЕКС($J$6:$J$17;
               МАКС(ПРОСМОТР(2;1/($J$6:$J$17<>"");СТРОКА($J$6:$J$17));
               ПРОСМОТР(2;1/($L$6:$L$17<>"");СТРОКА($L$6:$L$17));
               ПРОСМОТР(2;1/($N$6:$N$17<>"");СТРОКА($N$6:$N$17));
               ПРОСМОТР(2;1/($P$6:$P$17<>"");СТРОКА($P$6:$P$17));
               ПРОСМОТР(2;1/($R$6:$R$17<>"");СТРОКА($R$6:$R$17));
               ПРОСМОТР(2;1/($T$6:$T$17<>"");СТРОКА($T$6:$T$17))
)-5;1)="";0;
ИНДЕКС($J$6:$J$17;
               МАКС(ПРОСМОТР(2;1/($J$6:$J$17<>"");СТРОКА($J$6:$J$17));
               ПРОСМОТР(2;1/($L$6:$L$17<>"");СТРОКА($L$6:$L$17));
               ПРОСМОТР(2;1/($N$6:$N$17<>"");СТРОКА($N$6:$N$17));
               ПРОСМОТР(2;1/($P$6:$P$17<>"");СТРОКА($P$6:$P$17));
               ПРОСМОТР(2;1/($R$6:$R$17<>"");СТРОКА($R$6:$R$17));
               ПРОСМОТР(2;1/($T$6:$T$17<>"");СТРОКА($T$6:$T$17))
)-5;1))

В таблицу А
А-1
=ЕСЛИ(ИНДЕКС(J:J;$A$21;1)="";0;ИНДЕКС(J:J;$A$21;1))
А-2
=ЕСЛИ(ИНДЕКС(L:L;$A$21;1)="";0;ИНДЕКС(L:L;$A$21;1))
Далее по аналогии...

Доп.таблицу определяющую № хода
А20:J21

Где А21 =МАКС(B21:G21)
Где B21 =ПРОСМОТР(2;1/(J:J<>"");СТРОКА(J:J))
Где С21 =ПРОСМОТР(2;1/(L:L<>"");СТРОКА(L:L))
Далее по аналогии...


P.S. Можно далее собрать все в одну строчку без применения доп. таблице. Ну это уже другой вопрос... 

''''''''''''''''''''''''''''''''''''''''''''''''''Записать в - ЭтаКнига 
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "^{TAB}"
End Sub
Private Sub Workbook_Open()
    Application.OnKey "^{TAB}", "Openlink"
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''' Записать в модуль 
Sub Openlink()
'В переменной NameSheet - указать имя листа и ячейку с выпадающим списком. 
NameSheet = Worksheets("Columbus").Range("E6").Value
Worksheets(NameSheet).Activate
End Sub