Private Sub ToReport(Sh As Worksheet, Optional StartRow As Long = 1)
     Dim M(), P(), R&, C&, Ri&, Ci&, k&
      
     With Sh
         M = .[a1].Resize(.Cells(.Rows.Count, 37).End(xlUp).Row, 36).Value
     End With
      
     ReDim P(1 To (UBound(M) - 7) / 4, 1 To 126)
     For R = 8 To UBound(M) Step 4
         Ri = Ri + 1
         P(Ri, 1) = M(R, 2)
         P(Ri, 2) = M(R, 4)
         Ci = 2
         For C = 5 To 36
             If IsNumeric(M(4, C)) Then
                 For k = 0 To 3
                     Ci = Ci + 1
                     P(Ri, Ci) = M(R + k, C)
                 Next k
             End If
         Next C
     Next R
     R = UBound(P)
     Лист3.Cells(StartRow, 1).Resize(R, 126) = P
     StartRow = StartRow + R
End Sub

Private Sub CommandButton1_Click()
     Dim i&: i = 2
     ToReport Лист1, i
     ToReport Лист4, i
End Sub