Sub Add_Connecotion_Current_Table()

  Dim wb As Workbook
  Dim ws As Worksheet
  Dim io As ListObject
  Dim tName As String
  Dim sName As String
  Dim sFormula As String
  Dim wq As WorkbookQuery
  Dim bExists As VbMsgBoxResult
  Dim vbAnswer As VbMsgBoxResult
  Dim i As Long
  Dim dStart As Double
  Dim dTime As Double
  'Display message box to prompt user to run the macro
  vbAnswer = MsgBox("Run Macro?", vbYesNo, "PowerQuery Connect Current Table")
  If vbAnswer = vbYes Then
    dStart = Timer
    tName = ActiveCell.ListObject.Name
    Set wb = ActiveWorkbook
    Set io = wb.ActiveSheet.ListObjects(tName)
    sName = io.Name
'_____________________________First Query - Источник
    sFormula = "Excel.CurrentWorkbook(){[Name=""" & sName & """]}[Content]"
    'Check if query exists
    bExists = False
    For Each wq In wb.Queries
      If InStr(1, wq.Formula, sFormula) > 0 Then
        bExists = True
        MsgBox "Current Name of Query already exists", _
          vbOKOnly, "Exit Process"
        Exit Sub
      End If
    Next wq
    'Add query if it does not exist
    If bExists = False Then
      'Add query
      wb.Queries.Add Name:=sName & "ИСТ", _
        Formula:="let" & Chr(13) & "" & Chr(10) & _
        "   Source = Excel.CurrentWorkbook(){[Name=""" & sName & """]}[Content]" _
        & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "   Source"
    End If
'_____________________________Second Query - Обработка
    sFormula = sName & "ИСТ"
    'Check if query exists
    bExists = False
    For Each wq In wb.Queries
      If InStr(1, wq.Formula, sFormula) > 0 Then
        bExists = True
        MsgBox "Current Name of Query already exists", _
          vbOKOnly, "Exit Process"
        Exit Sub
      End If
    Next wq
    'Add query if it does not exist
    If bExists = False Then
      'Add query
      wb.Queries.Add Name:=sName & "ОБР", _
        Formula:="let" & Chr(13) & "" & Chr(10) & _
        "   Source = " & sName & "ИСТ" _
        & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "   Source"
    End If
'_____________________________Third Query - Результат
    sFormula = sName & "ОБР"
    'Check if query exists
    bExists = False
    For Each wq In wb.Queries
      If InStr(1, wq.Formula, sFormula) > 0 Then
        bExists = True
        MsgBox "Current Name of Query already exists", _
          vbOKOnly, "Exit Process"
        Exit Sub
      End If
    Next wq
    'Add query if it does not exist
    If bExists = False Then
      'Add query
      wb.Queries.Add Name:=sName & "РЕЗ", _
        Formula:="let" & Chr(13) & "" & Chr(10) & _
        "   Source = " & sName & "ОБР" _
        & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "   Source"
    End If
    
    'Calc run time
    dTime = Timer - dStart
  
    MsgBox "Connection have been created in " & Format(dTime, "0,0") & " seconds.", _
      vbOKOnly, "Process Complete"
  End If
End Sub