Sub ts()
Dim c As Range, LastRow1 As Integer, LastRow2 As Integer, s As Integer, rz As Integer

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For i = 2 To Sheets.Count

With Sheets(i)
Dim A As Integer, B As Integer
LastRow2 = Sheets(1).Cells(Rows.Count, 11).End(xlUp).Row
LastRow1 = .Cells(3, 1).End(xlDown).Row

s = i
If s = 2 Then
s = 0
ElseIf i = 3 Then
s = 8
Else
s = (i - 2) * 7 + 1
End If
Sheets(i).Range("A3:H" & LastRow1 - 1).Copy Sheets(1).Cells(LastRow2 + 1, 11)
For Each c In .Range(.[I3], .Cells(LastRow1, "V"))
A = Hour(.Cells(c.Row, c.Column))
B = Hour(.Cells(c.Row, c.Column + 1))
If c.Value = "" Then
R = ""
End If
If B - A > 12 Then
R = 2
ElseIf Not c.Value = "" Then
R = 1
End If

Select Case c.Column
Case 9: Sheets(1).Cells(c.Row + LastRow2 - 2, s + 18) = R: 'Sheets(1).Cells(LastRow + 2, s+18) = Sheets(1).Cells(1, c.Column).Value
Case 11: Sheets(1).Cells(c.Row + LastRow2 - 2, s + 19) = R: 'Sheets(1).Cells(LastRow2 - 2, s+19) = Sheets(1).Cells(1, c.Column).Value
Case 13: Sheets(1).Cells(c.Row + LastRow2 - 2, s + 20) = R: 'Sheets(1).Cells(LastRow2 - 2, s+20) = Sheets(1).Cells(1, c.Column).Value
Case 15: Sheets(1).Cells(c.Row + LastRow2 - 2, s + 21) = R: 'Sheets(1).Cells(LastRow2 - 2, s+21) = Sheets(1).Cells(1, c.Column).Value
Case 17: Sheets(1).Cells(c.Row + LastRow2 - 2, s + 22) = R: 'Sheets(1).Cells(LastRow2 - 2, s+22) = Sheets(1).Cells(1, c.Column).Value
Case 19: Sheets(1).Cells(c.Row + LastRow2 - 2, s + 23) = R: 'Sheets(1).Cells(LastRow2 - 2, s+23) = Sheets(1).Cells(1, c.Column).Value
Case 21: Sheets(1).Cells(c.Row + LastRow2 - 2, s + 24) = R: 'Sheets(1).Cells(LastRow2 - 2, s+24) = Sheets(1).Cells(1, c.Column).Value

End Select

Next c

End With
Next i
End Sub