Sub Step1()
    Dim y As Long
    Dim a As Variant
    Dim s1 As String
    Dim s2 As String
    
    Dim sh1 As Worksheet
    Set sh1 = Worksheets("Исходные данные")
    With sh1
        y = .Cells(Rows.Count, 2).End(xlUp).Row
        a = .Range(.Cells(2, 1), .Cells(y, 4))
    End With
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    For y = LBound(a, 1) To UBound(a, 1)
        Select Case a(y, 1)
        Case ""
            Select Case a(y, 2)
            Case "Состав звена:", "Машины и механизмы:", "Материалы:"
                s2 = a(y, 2)
                Set dic.Item(s1).Item(s2) = CreateObject("Scripting.Dictionary")
            Case Else
                dic.Item(s1).Item(s2).Item(a(y, 2)) = dic.Item(s1).Item(s2).Item(a(y, 2)) + a(y, 3)
            End Select
        Case Else
            s1 = a(y, 2)
            Set dic.Item(s1) = CreateObject("Scripting.Dictionary")
        End Select
    Next
    
    Step2 dic
    Step3 dic, "Состав звена"
    Step3 dic, "Машины и механизмы"
    Step3 dic, "Материалы"
End Sub
Sub Step2(dic As Dictionary)
    Dim sh As Worksheet
    On Error Resume Next
        Const s = "Общие сведения"
        Application.DisplayAlerts = False
        Worksheets(s).Delete
        Application.DisplayAlerts = True
        Set sh = Worksheets.Add(After:=Sheets(Sheets.Count))
        sh.Name = s
    On Error GoTo 0
    sh.Cells(1, 1).Value = "наименование"
    sh.Cells(2, 1).Resize(dic.Count) = Application.Transpose(dic.Keys())
End Sub
Sub Step3(dic As Dictionary, s)
    Dim sh As Worksheet
    On Error Resume Next
        Application.DisplayAlerts = False
        Worksheets(s).Delete
        Application.DisplayAlerts = True
        Set sh = Worksheets.Add(After:=Sheets(Sheets.Count))
        sh.Name = s
    On Error GoTo 0
    sh.Cells(1, 1).Resize(1, 3) = Array("наименование", " ", "количество")
    Dim v1 As Variant
    Dim v2 As Variant
    Dim y As Long
    y = 2
    For Each v1 In dic.Keys
        If dic.Item(v1).Exists(s & ":") Then
            For Each v2 In dic.Item(v1).Item(s & ":").Keys
                sh.Cells(y, 1).Value = v1
                sh.Cells(y, 2).Value = v2
                sh.Cells(y, 3).Value = dic.Item(v1).Item(s & ":").Item(v2)
                y = y + 1
            Next
        End If
    Next
    sh.UsedRange.EntireColumn.AutoFit
End Sub