Power query automation for multiple columns as inputs in vba in ms excel - combinations

Question

I have multiple inputs in columns from which I need to create table for each column which has headers, Create connection using power query, Using these connections I need to add to the power query, and export it to sheet2. I have attached sample excel sheet for reference. Below is the half code for the same, I am not pro in vba if any one could help in solving the same. Here is the link for the same which I need to automate.
data set
Option Explicit
Public Sub test()
Dim wb As Workbook
Dim ws As Worksheet
Dim lo As ListObject
Dim tableobjects As ListObject
Dim sName As String
Dim sFormula As String
Dim wq As WorkbookQuery
Dim bExists As Boolean
Dim vbAnswer As VbMsgBoxResult
Dim vbDataModel As VbMsgBoxResult
Dim i As Long
Dim j As Long
Dim k, l As Long
Dim dStart As Double
Dim dTime As Double
Dim CellAddr As String
Dim CellValue As String
Dim RangeAddr As String
Dim Temp As String
Dim TotalNumberInputs As Integer
Dim answer As Integer
Dim TableExists As Boolean
Dim ListObj As ListObject
Repeat:
TotalNumberInputs = InputBox("Enter the total inputs", "input int number")
If TotalNumberInputs = 0 Then
MsgBox "Invalid Input!!!"
answer = MsgBox("Invalid Input!!! Do you want to continue Macro?", vbQuestion + vbYesNo + vbDefaultButton2, "Next step")
If answer = vbYes Then
GoTo Repeat
Else
Exit Sub
End If
End If
'Set variables
dStart = Timer
Set wb = ActiveWorkbook
Set ws = ActiveSheet
'Check of table exist or else create table
For k = 1 To TotalNumberInputs
ws.Cells(1, k).Select
CellAddr = Selection.Address(RowAbsolute:=False, ColumnAbsolute:=False)
CellValue = Cells(1, l).Value ' "Table" & (k + "0") ' Selection.Value
On Error Resume Next
Set ListObj = ActiveSheet.ListObjects(CellValue)
On Error GoTo 0
If ListObj Is Nothing Then
Range(CellAddr).Select
Range(Selection, Selection.End(xlDown)).Select
RangeAddr = Selection.Address
Range(RangeAddr).Activate
ws.ListObjects.Add(SourceType:=xlSrcRange, Source:=Range(RangeAddr), LinkSource:=False, XlListObjectHasHeaders:=xlYes, tablestyleName:="TableStyleMedium28").Name = CellValue
Else
'If the table does exist clear filter from column C
' ActiveSheet.ListObjects(CellValue).Range.AutoFilter Field:=3
End If
Next k
l = 1
'Loop sheets and tables
' For Each ws In ActiveWorkbook.Worksheets
For Each lo In ws.ListObjects ' For j = 1 To TotalNumberInputs ' For Each lo In ws.ListObjects
sName = lo.Name ' ws.Cells(1, l).Value ' lo.Name
l = l + 1
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
End If
Next wq
'Add query if it does not exist
If bExists = False Then
' Add a Query
wb.Queries.Add Name:=sName, Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Excel.CurrentWorkbook(){[Name=""" & sName & """]}[Content]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Source,{{""" & sName & """, type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
'Add connection
wb.Connections.Add2 Name:="Query - " & sName, _
Description:="Connection to the '" & sName & "' query in the workbook.", _
ConnectionString:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & sName & ";Extended Properties=""""", _
CommandText:="SELECT * FROM [" & sName & "]", _
lCmdtype:=2, _
CreateModelConnection:=False, _
ImportRelationships:=False
'Count connections
i = i + 1
End If
Next lo ' Next j ' Next lo
'Next ws
'Calc run time
dTime = Timer - dStart
MsgBox i & " connections have been created in " & Format(dTime, "0.0") & " seconds.", vbOKOnly, "Process Complete"
End Sub