Sub macros (ParamArray varname()) 'varname это таблица которая передается в качестве исходной таблицы с данными 
On Error Resume Next

 Dim Query As Range, ResArea As Range
 Dim srcSheet As Worksheet, resSheet As Worksheet
    
    Application.ScreenUpdating = False
    
    'Sheets(2).Visible = True
    'Sheets(4).Visible = True

    Set resSheet = Sheets(4)                                'Целевая страница
    Set srcSheet = Sheets(2)                                'Исходная страница
'    resSheet.Activate
    Const StValCol = 2                                      'номер первого столбца с показателями
    Const hdrs = 1                                          'количество строк заголовка
    
    Range(resSheet.Rows(9), resSheet.Rows(64000)).Delete        'очистка
    
    
    Set Query = varname(1)
    irow = Query.Rows.Count
    icol = Query.Columns.Count

    If irow > 1 And Left(Query(1, 1), 5) Then
    Application.ScreenUpdating = False
    
     Query.Columns(2).Delete
     Query.Cells(2, 1) = "Всего по ОАО Мармышки"
     Query.Rows(3).Insert shift:=xlDown
     Query.Cells(3, 1) = "В том числе:"
     
    Set Query = Query.Offset(hdrs, 0)                     ' сдвиг на уровень заголовка
    Set editArea = editArea.Resize(irow, icol + 1)        ' переопределение диапазона 
 
    'расчёт размерности диапазона
    irow = editArea.Rows.Count
    icol = editArea.Columns.Count
   
    Query.Copy
    resSheet.Cells(9, 3).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Set ResArea = Range(resSheet.Cells(9, 3), resSheet.Cells(9 + irow - 1, 3 + icol))
    
    Call Format(ResArea, StValCol)
    
    Else
    resSheet.Cells(9, 3) = "Данные по выбранным селекционным данным отсутствуют в системе"
    Set ResArea = Range(resSheet.Cells(9, 3), resSheet.Cells(9, 8))
    End If
    
    'устанавливаем область печати
    resSheet.PageSetup.PrintArea = Range(resSheet.Cells(1, 1), ResArea(ResArea.Rows.Count + 1, ResArea.Columns.Count + 1)).Address
    

    resSheet.Cells(1, 1).Select
    Application.ScreenUpdating = True
End Sub

Sub Format(ResArea, StValCol)
    
    With ResArea
        .Interior.ColorIndex = 0
        .Borders.LineStyle = 1
        .Borders.ColorIndex = 1
      
    End With
    'K = Range(ResArea.Columns(StValCol), ResArea.Columns(ResArea.Columns.Count)).Address
    With Range(ResArea.Columns(StValCol), ResArea.Columns(ResArea.Columns.Count))
        .NumberFormat = "#,##0.00"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
   
   
    With ResArea.Rows(1)
        .Font.Bold = True
    End With

   
End Sub