Sub etst()
    Dim lastrow As Long 'объявляем переменную
       For j = 1 To 2 'тут кол-во строк откуда тянем (в примере "B5:B6" 2 строки). Объявление цикла
        For i = 2 To 8 ' столбцы исх табл (все 3 таблицы у Вас содержат по 8 столбцов) Объявление цикла
         If Cells(j + 4, i) <> "" Or Cells(j + 4, i + 8) <> "" Or Cells(j + 4, i + 16) <> "" Then 'смотрим чтобы хоть в 1 из 3 таблиц было значение 
          lastrow = Cells(Rows.Count, 1).End(xlUp).Row 'ищем последнюю заполненную строку
          Cells(lastrow + 1, 1) = Cells(lastrow, 1).Value + 1 'проставляем порядковый номер
          Cells(lastrow + 1, 2) = Cells(j + 4, i) 'переносим значение из 1 таблицы, например C5 (j+4 означает 5 строку)
          Cells(lastrow + 1, 3) = Cells(j + 4, i + 8) 'переносим значение из 2 таблицы, например K5 (i+8 означает столбец K)
          Cells(lastrow + 1, 4) = Cells(j + 4, i + 16)'переносим значение из 3 таблицы, например S5 (i+16 означает столбец S)
         End If
       Next i, j
End Sub

ЕСЛИ(ТРАНСП($B$5:$H$5)="";"";ТРАНСП($B$5:$H$5))

ОСТАТ((СТРОКА(A1)-1)/27;96)+1