Dim Sh As Worksheet
Dim arrTemp, arrV() 
Dim I&, N&, iRow&
Application.ScreenUpdating = False
On Error Resume Next
With Worksheets("водители-экспедиторы")
    arrTemp = .Range("B3:V" & .Cells(.Rows.Count, "B").End(xlUp).Row).Value
End With
    With Worksheets("Заявка")
        For I = 1 To UBound(arrTemp) 
            If arrTemp(I, 1) = .Range("F7") Then 
                ReDim Preserve arrV(8, N)
                arrV(0, N) = .Range("F7").Value 'arrV(0, N) столбец строка???
                arrV(1, N) = arrTemp(I, 6)
                arrV(2, N) = arrTemp(I, 7)
                arrV(3, N) = arrTemp(I, 8)
                arrV(4, N) = arrTemp(I, 2)
                arrV(5, N) = arrTemp(I, 9)
                arrV(6, N) = "Контрагенты грузоотправителя,согласно маршрута доставки"
                arrV(7, N) = arrTemp(I, 1)
                N = N + 1
            End If
        Next
        .Copy After:=Worksheets(Worksheets.Count) 
    End With
    With ActiveSheet
        N = 1
        For Each Sh In Worksheets
            If Sh.Name Like "*" & .Range("F7").Text & "*" Then N = N + 1
        Next
        .Name = .Range("F7").Text & " (" & N & ")"
        .Rows("1:6").Delete Shift:=xlUp
        .Shapes.Range(Array("AutoShape 2")).Delete
        .Range("A1").Value = .Range("A1").Value & " " & N
        iRow = .Columns(1).Find("Дата доставки", LookIn:=xlValues).Row + 1
        .Rows(iRow).Resize(UBound(arrV, 2)).Insert
        .Range("A" & iRow).Resize(UBound(arrV, 2) + 1, 7) = Application.Transpose(arrV)
        'ниже форматируются вставленные данные по водителям
        With Range("A" & iRow & ":H" & iRow + UBound(arrV, 2))
            .EntireRow.AutoFit
            .HorizontalAlignment = xlCenter
            .Font.Bold = True
        End With
    End With
'ActiveWindow.View = xlNormalView
Application.ScreenUpdating = True
End Sub

.Copy After:=Worksheets(Worksheets.Count)

Dim arrTemp, arrV() 

For Each Sh In Worksheets            If Sh.Name Like "*" & .Range("F7").Text & "*" Then N = N + 1
        Next
        .Name = .Range("F7").Text & " (" & N & ")"
        .Rows("1:6").Delete Shift:=xlUp
        .Shapes.Range(Array("AutoShape 2")).Delete
        .Range("A1").Value = .Range("A1").Value & " " & N
        iRow = .Columns(1).Find("Дата доставки", LookIn:=xlValues).Row + 1
        .Rows(iRow).Resize(UBound(arrV, 2)).Insert
        .Range("A" & iRow).Resize(UBound(arrV, 2) + 1, 7) = Application.Transpose(arrV)
        'ниже форматируются вставленные данные по водителям
        With Range("A" & iRow & ":H" & iRow + UBound(arrV, 2))
            .EntireRow.AutoFit
            .HorizontalAlignment = xlCenter
            .Font.Bold = True
        End With
    End With