Sub Macros()
Application.ScreenUpdating = False 'отключаем обновление экрана, экран не моргает, макрос работает быстрее.
Dim i As Long, j As Long 'описание переменных
j = 1 'не буду комментировать
Set PN = Worksheets("Как должно быть") 'переменной PN присваивается объект Лист
For Each SN In ThisWorkbook.Sheets 'цикл по всем листам книги
       If SN.Name <> PN.Name Then 'если Лист не тот на котором собираем данные выполняем следующие операторы
           For i = 2 To SN.Range("F2").End(xlDown).Row 'цикл по ячейкам таблицы от 2 ячейки до последней
               If SN.Range("E" & i) <> "" Then j = j + 1: PN.Range("D" & j) = SN.Range("F" & i) 'если в столбце Е не пусто, то в F нужные данные, записываем
               If IsNumeric(Left(SN.Range("F" & i), 8)) Then PN.Range("C" & j) = Left(SN.Range("F" & i), 8) 'если первые 8 знаков в столбце F число, то записываем эти знаки
           Next i
       End If
Next
PN.Range("C2:D" & j).Sort Key1:=PN.Range("C2") 'сортировка полученной таблицы
For i = j To 2 Step -1 'цикл по строкам для вставки пустых строк
       If PN.Range("C" & i) <> PN.Range("C" & i).Offset(-1, 0) And PN.Range("C" & i).Offset(-1, 0) <> "" Then 'если текущее значение отлично от значения выше,
           PN.Rows(i).Insert Shift:=xlDown 'то вставляем пустую строку
       End If
Next i
Application.ScreenUpdating = True 'включаем обновление экрана
End Sub