Заполнить брешь

Option Explicit
 
Sub AeroButtonStart()
    On Error Resume Next
    ActiveSheet.Shapes(Application.Caller).Visible = 1
    Run ActiveSheet.Shapes(Application.Caller).Name
End Sub
 
 
Sub AeroButton1()
    Dim r As Range, i&, j&, jj&, b&, s$
    Call AeroButton2 'Делаем как было
    Set r = [g1]
    Set r = Cells.Find(What:="загаловок1", After:=r, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    Do
        If r.Column = 7 Then
            j = r.Row + 1: i = r.Column: b = 0
            For jj = j To j + &H7FFF 'Большое число :)
 
                If IsEmpty(Cells(jj, i).Value) And b = 0 Then 'Вычисляем сколько в таблице строк
                    b = 1 'Первое пустое значение
                ElseIf Not IsEmpty(Cells(jj, i).Value) And b = 1 Then
                    b = 2 'Первое не пустое значение
                ElseIf IsEmpty(Cells(jj, i).Value) And b = 2 Then
                    Exit For 'Выход если в столбце опять найденно пустое
                End If
                
            Next
            
            For i = r.Column To r.Column + 2
                Set r = Range(Cells(j, i), Cells(jj - 1, i))
                r.FillUp '-------------------------------------------Заполнить вверх
            Next
            Set r = Cells(j, i)
        End If
        
        Set r = Cells.FindNext(After:=r)
         If InStr(s, r.Address) = 0 Then s = s & "," & r.Address Else Exit Do 'Выход из цикла если результат поиска повторился
    Loop
    
End Sub
 
Sub AeroButton2()
    '
    'Копируем исходную таблицу
    '
    Range("A2:D22").Copy
    Range("G2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub

For i = 1 To rng.Columns.Count - 1
        tmp = GetValue(Range(rng.Cells(2, i), rng.Cells(rng.Rows.Count, i)))
        For j = 2 To rng.Rows.Count
            rng.Cells(j, i) = tmp
        Next j
    Next i

Sub Test()
 
For Each ws In ThisWorkbook.Worksheets
 
  If ws.Name <> "Лист 1" And ws.Name <> "Лист 2" 
 
ws.Select
 
    Dim rng As Range
    Dim startCell As Range
    Dim endCell As Range
    Dim table As Range
    Dim offx As Integer
   
    
    Set rng = GetUsedRange(1)
        
    
    For i = 1 To rng.Rows.Count
        If rng.Cells(i, 1) = header Then
            offx = rng.Cells(i, 1).End(xlToRight).Column - rng.Cells(i, 1).Column
            Set startCell = rng.Cells(i, 1)
            Set endCell = GetLastRowCell(Range(rng.Cells(i, 1).Offset(1, 0), rng.Cells(rng.Rows.Count, 1)))
    
            startCell.Select
            endCell.Offset(0, offx).Select
            
           SetValues Range(startCell, endCell.Offset(0, offx))
        End If
    Next i
    
  End If
  Next  
    
End Sub

 If ws Is Nothing Then
        Set ws = ActiveSheet
    End If

Если ws ничего не значит
        Установить ws = АктивныйЛист
    Конец

If ws Is Nothing Then
        Set ws = ActiveSheet
    End If