Sub Копирование()
     Dim Sh As Worksheet, Sh1 As Worksheet, Вход, _
         Curent_Letter As Integer, Letter As String, Curent_Row As Long
     Set Sh = ThisWorkbook.Worksheets("Лист1")
     Set Sh1 = ThisWorkbook.Worksheets("Лист2")
     ABC = Array("", "А", "В", "С")
     col = Array(0, 2, 3, 4, 6, 7, 8, 9, 13, 13)
     lLastRowMY = Sh1.Cells(Sh1.Rows.Count, "B").End(xlUp).Row
     Вход = Sh1.Range("B4:J" & lLastRowMY)
     Curent_Letter = 1
     Curent_Row = 2
     With Sh
        For n = 1 To UBound(Вход)
             Letter = ABC(Curent_Letter)
             If Вход(n, 4) = "A" Then Вход(n, 4) = "А"
             If Вход(n, 4) = "B" Then Вход(n, 4) = "В"
             If Вход(n, 4) = "C" Then Вход(n, 4) = "С"
             If Вход(n, 4) <> Letter Then
                 n = n - 1
                 For i = 1 To UBound(col)
                     .Cells(Curent_Row, col(i)) = "-"
                 Next
                 .Cells(Curent_Row, 6) = Letter
                 Curent_Row = Curent_Row + 1
             Else
                 For i = 1 To UBound(col)
                     .Cells(Curent_Row, col(i)) = Вход(n, i)
                 Next
                 Curent_Row = Curent_Row + 1
             End If
             Curent_Letter = Curent_Letter + 1
             Curent_Letter = IIf(Curent_Letter < 4, Curent_Letter, 1)
         Next
     End With

End Sub