Private Sub Button1_Click(sender As Object, e As RibbonControlEventArgs) Handles Button1.Click
        Dim wb As excel.Workbook = Globals.ThisAddIn.Application.ActiveWorkbook
        Dim sh As excel.Worksheet = wb.ActiveSheet
        Dim range As excel.Range = sh.Range("A1")

        On Error GoTo ERRH

        Dim cn3 As New ADODB.Connection

        Call cn3.Open("Provider=SQLOLEDB.1;Integrated Security=SSPI;" _
        & "Initial Catalog=" + ComboBox1.Text + "; Data Source=" + EditBox1.Text + "")

        'cn3.ConnectionString = "Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=" + ComboBox1.Text + ";Data Source=" + EditBox1.Text + ";Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=CB901666;Use Encryption for Data=False;Tag with column collation when possible=False"

        'cn3.Open()
        Dim delt As String
        delt = "drop table " + EditBox1.Text + ""
        cn3.Execute(delt)

        With sh
            .Activate()
            .Cells.Clear()
            .Cells.ColumnWidth = 8.43
        End With

        range.Activate()

        EditBox1.Text = Nothing
        ComboBox2.Text = Nothing
        ComboBox1.Text = Nothing
        Exit Sub
ERRH:
        MsgBox("Error:" & " " & Err.Source)
    End Sub

Private Sub CommandButton2_Click()

    Dim cn As New ADODB.Connection
    Set cn = CreateObject("ADODB.Connection")
       
    
    cn.Provider = "SQLOLEDB.1"


    cn.ConnectionString = "Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=" + UserForm1("ComboBox1") + ";Data Source=" + UserForm1("TextBox1") + ";Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=CB901666;Use Encryption for Data=False;Tag with column collation when possible=False"
    
    
  cn.Open
  
 
  Dim nacstr As Long 'начальная строка
  nacstr = 2
  Dim pstr As Long 'конечная строка
  pstr = Cells(Rows.Count, 1).End(xlUp).row
  Dim kolnach As Long
  kolnach = 3
  Dim kolpas As Long
  kolpas = Cells(1, Columns.Count).End(xlToLeft).Column
    
    For i = nacstr To pstr
        If Cells(i, 2).Value = 1 Then
            For x = kolnach To kolpas
            Dim a As String
            a = Sheets("Лист1").Cells(1, x).Value
            Dim b As String
            b = Sheets("Лист1").Cells(i, x).Value
            Dim c As String
            c = Sheets("Лист1").Cells(1, 1)
            Dim d As String
            d = Sheets("Лист1").Cells(i, 1)
            Dim e As String
            e = UserForm1("ComboBox2").Value
            cn.Execute "update " + e + " set " + a + " = '" + b + "' Where " + c + " = '" + d + "'"
            
            Next x
            
        End If
    
    Next i
     UserForm1.Hide
End Sub

Sub Macro1()
    Dim st As String
    Dim ct As String
    Set cn = CreateObject("ADODB.Connection")
    Dim rs As New ADODB.Recordset
    
   Dim QT1 As QueryTable
    
    cn.Provider = "SQLOLEDB.1"


    cn.ConnectionString = "Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=" + Sheets("Лист4").Range("A2") + ";Data Source=" + Sheets("Лист4").Range("A1") + ";Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=CB901666;Use Encryption for Data=False;Tag with column collation when possible=False"
                            
    cn.Open
    rs.CursorType = adOpenStatic
    rs.LockType = adLockBatchOptimistic
    
    
    rs.Open "select * from dbo." + Sheets("Лист4").Range("A3") + "", cn
   
    st = "OLEDB;Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Data Source=tstfinserver;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=CB901666;Use Encryption for Data=False;Tag with column collation when possible=False"
    
    Set QT1 = ActiveWorkbook.Worksheets(2).ListObjects.Add(SourceType:=xlSrcExternal,
              Source:=Array(s), LinkSource:=True, _
              TableStyleName:=xlGuess, Destination:=Sheets("Лист2").Range("A1")).QueryTable
              
    ct = Sheets("Лист4").Range("A2").Value + ".dbo." + Sheets("Лист4").Range("A3").Value
   
    
   
    
 End Sub
 

Лист2.Range("A2").CopyFromRecordset rs 

'Set QT1 = ActiveWorkbook.Worksheets(2).ListObjects.Add(SourceType:=xlSrcExternal,
              'Source:=Array(s), LinkSource:=True, _
              'TableStyleName:=xlGuess, Destination:=Sheets("Лист2").Range("A1")).QueryTable
              
    'ct = Sheets("Лист4").Range("A2").Value + ".dbo." + Sheets("Лист4").Range("A3").Value