Sub a()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Arr
Arr = Sheets("Сопоставление").Range("A1:B100")
Dim LastRow As Long, i As Long, j As Long, k As Long, last As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row: k = 1
For i = 1 To LastRow
     If LCase(Sheets(1).Cells(i, 1).Value) Like "*сумма*" Then
      Workbooks.Add xlWBATWorksheet 'создание книги с одним листом
      With ActiveWorkbook.Sheets(1)
         ThisWorkbook.Sheets(1).Range("a" & k & ":h" & i - 1).Copy (.Range("a5"))
         ThisWorkbook.Sheets(1).Range("j" & k + 2 & ":q" & i - 1).Copy (.Range("a" & i - k + 5))
         .Cells.Borders.LineStyle = xlNone
         .Name = .Range("a5")
         last = .Cells(Rows.Count, 1).End(xlUp).Row
         .Range("a5:h" & last).Borders.LineStyle = xlContinuous
         .Columns("C:C").ColumnWidth = 30
         .Range("D:E").EntireColumn.Delete
         .Range("a5:f5").MergeCells = True
         .Rows("6:6").HorizontalAlignment = xlCenter
         .Rows("4:6").Font.Bold = True
         .Rows("7:" & last).Font.Size = 10
         .Range("a1").Value = "Накладная"
         .Range("a" & last + 2).Value = "Роспись в получении"
         For j = 1 To UBound(Arr)
         If Arr(j, 1) = .Range("a5") Then .Range("E4") = Arr(j, 2)
         Next j
         ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\" & .Range("a5") & ".xls")
         ActiveWorkbook.Close
      End With
         k = i + 1
     End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub a()
Dim LastRow As Integer, i As Integer, k As Integer, last As Integer
LastRow = Cells(Rows.Count, 1).End(xlUp).Row: k = 1
For i = 1 To LastRow
If LCase(Sheets(1).Cells(i, 1).Value) Like "*итого*" Then
Sheets.Add After:=Sheets(Sheets.Count)
With Sheets(Sheets.Count)
Sheets(1).Range("a" & k & ":h" & i - 1).Copy (.Range("a5"))
Sheets(1).Range("j" & k + 2 & ":q" & i - 1).Copy (.Range("a" & i - k + 5))
Cells.Borders.LineStyle = .Name = .Range("a5")
last = .Cells(Rows.Count, 1).End(xlUp).Row
With .Range("a5:h" & last)
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
.Columns("C:C").ColumnWidth = 10
.Range("a5:f5").MergeCells = True
.Rows("6:6").HorizontalAlignment = xlCenter
.Range("G4").FormulaR1C1 = "=VLOOKUP(R[1]C[-6],сопоставление!C[-6]:C[-3],2,0)"
.Range("a1").Value = "Накладная"
.Range("a" & last + 2).Value = "Роспись в получении"
.Range("a" & last + 4).Value = "__________________________________________________________________________"
.Range("a" & last + 5).Value = "__________________________________________________________________________"
.Range("a" & last + 6).Value = "__________________________________________________________________________"
End With
k = i + 1
End If
Next
End Sub

Sub ??????1()
i = 7
j = 8
Do While Cells(i, j).Value <> ""
amount = 0
Do While Cells(i, j).Value <> ""
amount = amount + Cells(i, j).Value
i = i + 1
Loop
Cells(i, j).Value = amount
j = j + 1
i = 1
Loop
End Sub