Dim lFCol As Long, lLCol As Long, I As Long
Dim sChiefMechanical As String, sDate As String, sHero As String
Dim shBl  As Worksheet, shOw As Worksheet, shAnotherHero As Worksheet
Dim r As Range
Sub EmptySpaces_InExSu()
  Call onAdnOn
  For I = lFCol To lLCol
    Call ShowMustGoOn(I) 'скрыть столбцы кроме текущего
    Call WhatWeAreLooking4(I)
    Call WhateverHappens
    'Stop
  Next
End Sub
Sub WhateverHappens()
  sHero = shOw.Cells(2, I) 'модель авто
  shBl.Copy after:=shBl
  Set shAnotherHero = ThisWorkbook.ActiveSheet
  shOw.Cells(2, 2).CurrentRegion.Copy _
    shAnotherHero.Cells(14, 2)
  With shAnotherHero
    .Rows("14:15").Delete
    .Range("c11").Value = sHero
    .Range("b9").Value = "за " & sDate
    lRowCM = .Range("b13").CurrentRegion.Rows.Count _
      + 2 + 13
    .Cells(lRowCM, 2) = sChiefMechanical
    .Name = sHero
  End With
End Sub
Sub onAdnOn()
  Set shOw = ThisWorkbook.Worksheets("Сводная")
  With shOw
    .Cells.MergeCells = False
    .Columns(1).Hidden = True
    sDate = .Range("d1")
    lFCol = 4: lLCol = .Range("b3").CurrentRegion.Columns.Count
  End With
  Set shBl = ThisWorkbook.Worksheets("Шаблон Акта")
  sChiefMechanical = "Гл. механик    ________________________  /Иванов А.В./"
End Sub
Sub WhatWeAreLooking4(ByVal CurCol As Long)
  Set r = shOw.Cells(2, CurCol).CurrentRegion
  r.AutoFilter Field:=CurCol, Criteria1:="<>"
End Sub
Sub ShowMustGoOn(ByVal CurCol As Long)  'скрыть столбцы кроме текущего
  shOw.Cells.EntireColumn.Hidden = False
  If shOw.FilterMode Then shOw.ShowAllData
  For j = lFCol To lLCol
    If j <> CurCol Then shOw.Columns(j).Hidden = True
  Next
End Sub