Sub Услуги()
Dim Uslugi As Variant, Klassy As Variant, Rabotniki As Variant
Dim LastRow As Long, i As Long, Summa As Long
Dim MyRange As Range
Dim GosNomer As String, Telephone As String, FIO As String
Dim Marka As String, Klass As String, VidPlateja As String
Dim Data As Date

'zadaem peremennye
Worksheets("Список").Activate
Data = Range("B1")
GosNomer = Range("H3")
Telephone = Range("H4")
FIO = Range("H5")
Marka = Range("H6")
VidPlateja = Range("I1")
Summa = Range("H1")
Summ = Range("J8")

'opredelyaem klass
Klassy = Range("C1:F2")
For i = LBound(Klassy, 2) To UBound(Klassy, 2)
    If Klassy(1, i) = True Then
        Klass = Klassy(2, i) 'Nashli vybrannyi klass avto
        Exit For
    End If
Next i

'opredelyaem rabotnikov
Rabotniki = Range("H9:I13")

'opredelyaem uslugi
Uslugi = Range("A1").CurrentRegion

'вычисление последней строки
Worksheets("Табель").Activate
LastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1

'vstavlyaem dannye
Range(Cells(LastRow, 1), Cells(LastRow, 1)) = Data
Range(Cells(LastRow, 2), Cells(LastRow, 2)) = Marka
Range(Cells(LastRow, 3), Cells(LastRow, 3)) = GosNomer
Range(Cells(LastRow, 4), Cells(LastRow, 4)) = FIO
Range(Cells(LastRow, 5), Cells(LastRow, 5)) = Telephone
Range(Cells(LastRow, 6), Cells(LastRow, 6)) = Klass

'vstavlyaem uslugi
Set MyRange = Range(Cells(LastRow, 7), Cells(LastRow, 7))

'перебираем
For i = LBound(Uslugi, 1) To UBound(Uslugi, 1)
If Uslugi(i, 1) = True Then
   'если еще ни одно не перенесено
   If IsEmpty(MyRange) Then
        MyRange = Uslugi(i, 2)
   'если уже был перенос значений
   Else
       MyRange = MyRange & Chr(44) & Chr(32) & Uslugi(i, 2)
   End If
End If
Next i

'vstavlyaem summu
Range(Cells(LastRow, 8), Cells(LastRow, 8)) = Summa
'vstavlyaem vid plateja
Range(Cells(LastRow, 9), Cells(LastRow, 9)) = VidPlateja

Range(Cells(LastRow, 11), Cells(LastRow, 11)) = Summ


'vstavlyaem rabotnikov
Set MyRange = Range(Cells(LastRow, 10), Cells(LastRow, 10))
For i = LBound(Rabotniki, 1) To UBound(Rabotniki, 1)
If Rabotniki(i, 1) = True Then
   'если еще ни одно не перенесено
   If IsEmpty(MyRange) Then
        MyRange = Rabotniki(i, 2)
   'если уже был перенос значений
   Else
       MyRange = MyRange & Chr(44) & Chr(32) & Rabotniki(i, 2)
   End If
End If
Next i

End Sub