Sub Обновить_текущий_город()
Dim cn As Object 'New ADODB.Connection
Dim rec As Object 'ADODB.Recordset
Dim dtfr, dtto, PosStr
Dim sh, sh1, sh2 As Worksheet
    Set sh = ThisWorkbook.Sheets("Свод")
    Set sh1 = ThisWorkbook.Sheets("Ошибки")
    Set sh2 = ThisWorkbook.Sheets("Настройки")
        
    dtfr = Format(sh.Range("B1"), "YYYYMMDD")
    dtto = Format(sh.Range("B2"), "YYYYMMDD")
    
' проверка на дурака, даты
    If dtfr = "" Or dtto = "" Then
        MsgBox "Проверьте, не должно быть не заполненного периода!", vbCritical
        Exit Sub
    Else
        If dtto < dtfr Then
            MsgBox "Дата начала периода не может быть больше даты окончания!", vbCritical
            Exit Sub
        End If
    End If
    
'соединение
    Set cn = CreateObject("ADODB.Connection")
    cn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=***;Password=***;" _
                          & "Data Source=***;Use Procedure for Prepare=1;Auto Translate=True"
    cn.Open
'рекордсет
    Set rec = CreateObject("ADODB.Recordset")
    rec.CursorType = adOpenDynamic
    rec.LockType = adLockOptimistic
    ' обновляем первую, сводную таблицу
    sh.PivotTables("Свод").PivotCache.CommandText = _
     "exec [dbo].[Masinev_Transport_Imput_to_InkTransportReport_check] @frDate = '" & dtfr & "',@toDate = '" & dtto & "',@branch = '" & sh2.Cells(2, 3) & "'"
    On Error Resume Next
    sh.PivotTables("Свод").PivotCache.Refresh
    
    ' обновляем вторую таблицу, предварительно очистив данные
    If sh1.Range("A2") = "" Then
    Else
        PosStr = sh1.Cells(1, 1).End(xlDown).Row
        sh1.Range("A2:D" & PosStr).ClearContents
    End If
    rec.Open "exec Masinev_Transport_Imput_to_InkTransportReport_mistakes @branch = '" & NameBook & "'", cn
    sh1.Range("A2").CopyFromRecordset rec
    rec.Close
    cn.Close
    
End Sub

Global sn
Global PosStr As Integer

Sub deletrs() 'удаление записей

Dim i, t As Integer
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset

Set sn = ThisWorkbook.Sheets("test")

PosStr = sn.Cells(6, 3).End(xlDown).Row

t = 6
i = 1
Dim arr() As Integer
ReDim arr(1 To i) As Integer
   
   For t = 6 To PosStr
     If IsEmpty(sn.Cells(t, 1)) = False Then
       arr(i) = sn.Cells(t, 9)
       i = i + 1
     End If
   Next
 
cn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=******;Password=******;Data Source=ahdb1c;Use Procedure for Prepare=1;Auto Translate=True"
cn.Open

'открываем recordset
Set rs = CreateObject("ADODB.Recordset")
rs.cursortype = adOpenKeyset
rs.locktype = adLockOptimistic
rs.Open "select * from baza.dbo.mog_корректировка_бюджета_copy", cn

i = 1
    For i = LBound(arr) To UBound(arr)
        rs.Find "id=" & arr(i)
        rs.Delete
        rs.movenext
    Next
    
PosStr = Empty
MsgBox ("Данные удалены")

End Sub