If ActiveSheet.AutoFilterMode Then
ActiveSheet.AutoFilterMode = False
End If
Range("a1").AutoFilter  1 , "<>1*"
ActiveSheet.AutoFilter.Range.SpecialCells(xlVisible).EntireRow.Select
Selection.Rows.Count = Slr
Sheets("333").Select
Cells(ik +  1 , n +  1 ).Value = Slc -  1 

    Sheets("çàïðîñ1").Activate
    ActiveSheet.AutoFilterMode = False
    Application.CutCopyMode = False
    Selection.ClearContents
    Selection.QueryTable.Delete

Sub qqq_()

Set myObject = ActiveWorkbook
Dim serv( 3 )
serv( 1 ) = "s1"
serv( 2 ) = "s2"
serv( 3 ) = "s3"
For ik =  1  To  3 
Dim proc_( 5 )
proc_( 1 ) = "STAT_ND"
proc_( 2 ) = "stat_NP"
proc_( 3 ) = "stat_notsum"
proc_( 4 ) = "notopl"
proc_( 5 ) = "nototm"

For n =  1  To  5 
Sheets("q1").Select
    Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
        "ODBC;DRIVER=SQL Server;SERVER=" + serv(ik) + ";UID=Ivanov;APP=Microsoft® Query;WSID=horse;Trusted_Connection=Yes" _
        , Destination:=Range("A1"))
        .CommandText = Array("exec BD.dbo." + proc_(n) + "")
        .Name = "Запрос из " + serv(ik) + ""
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod =  0 
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
 
   If ActiveSheet.AutoFilterMode Then

    ActiveSheet.AutoFilterMode = False
    End If
    Range("a1").AutoFilter  1 , "<>1*"
    ActiveSheet.AutoFilter.Range.SpecialCells(xlVisible).EntireRow.Select
    Selection.Copy
'Selection.Rows.Count = Slr
Sheets("111").Select
    Cells( 1 ,  1 ).Activate
   ActiveSheet.Paste

Sheets("111").Select
Range("a:a").Select
Slc = Range("a65536").End(xlUp).Row -  1 
                                   
Sheets("333").Select
Cells(ik +  6 , n +  1 ).Value = Slc

    Sheets("q1").Activate
    ActiveSheet.AutoFilterMode = False
   
    Application.CutCopyMode = False
    Selection.ClearContents
    Selection.QueryTable.Delete
    Sheets("111").Select
    Cells.Select
    Selection.Delete
    
Next n
        Next ik
End Sub