Loop through rows and when empty move to next column

[Green Squirrel]

I've been spending days in trying to figure out how I need to do this but just can't find it. Hope some one is kind enough to help me out.
The goal of this script is to get a table from a website and put them in a table in Excel.

But I need 6 (For the time being. In the future this will be more than 26 different tables) different tables and I don't want to make a sub for each table request.
So I put all the variable data on Sheet1 of my file.

The idea is that my script goes over each column and gets the table that I need until there is an empty column. To get this data for 1 column isn't an issue as this is working.
The issue is that I just can't figure out how I can move on to column B, column C, ... until there is an empty column.

I've been trying every single thing that I found online, but nothing seem to get it going. If somebody can help me out or give me clear pointers how to do that would be very much appreciated.

Script

Sub ImportTBL1()
   
    Dim sourceSheet As Worksheet
    Dim QT As QueryTable
    Dim destCell As Range
    Dim qtResultRange As Range
    Dim TBL As String
    Dim URL As String
    Dim DES As String
    Dim COL As String
   
    Set sourceSheet = Sheet6
    Dim rng As Range: Set rng = Application.Range("Sheet1!A1")
    Dim cel As Range
       
        For Each cel In rng.Cells
            TBL = rng.Cells(1, 1)
            URL = rng.Cells(2, 1)
            DES = rng.Cells(3, 1)
            COL = rng.Cells(4, 1)
        Next cel
        
    With sourceSheet
        Set destCell = .Range(DES)
        On Error Resume Next
        .ListObjects(TBL).Delete
        On Error GoTo 0
    End With
   
    Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=destCell)
   
    With QT
        .RefreshStyle = xlOverwriteCells
        .WebFormatting = xlNone
        .WebSelectionType = xlSpecifiedTables
        .WebTables = COL
        .BackgroundQuery = False
        .Refresh
        Set qtResultRange = .ResultRange
        .Delete
    End With
   
    With destCell
        .Worksheet.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes).Name = TBL
        sourceSheet.ListObjects(TBL).ShowAutoFilterDropDown = False
    End With

End Sub

 

[AlphaFrog]

Try this (not tested).

Sub ImportTBL1()
   
    Dim sourceSheet As Worksheet
    Dim QT As QueryTable
    Dim destCell As Range
    Dim qtResultRange As Range
    Dim TBL As String
    Dim URL As String
    Dim DES As String
    Dim COL As String
   
    Set sourceSheet = Sheet6
    Dim rng As Range:
    
    'Loop through each used cell in row 1
    For Each rng In Sheets("Sheet1").Range("A1", Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft))
    'Dim cel As Range
       
        'For Each cel In rng.Cells   'rng is only one cell. No need to loop through one cell
            TBL = rng.Cells(1, 1)
            URL = rng.Cells(2, 1)
            DES = rng.Cells(3, 1)
            COL = rng.Cells(4, 1)
        'Next cel
             
         With sourceSheet
             Set destCell = .Range(DES)
             On Error Resume Next
             .ListObjects(TBL).Delete
             On Error GoTo 0
         End With
        
         Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=destCell)
        
         With QT
             .RefreshStyle = xlOverwriteCells
             .WebFormatting = xlNone
             .WebSelectionType = xlSpecifiedTables
             .WebTables = COL
             .BackgroundQuery = False
             .Refresh
             Set qtResultRange = .ResultRange
             .Delete
         End With
        
         With destCell
             .Worksheet.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes).Name = TBL
             sourceSheet.ListObjects(TBL).ShowAutoFilterDropDown = False
         End With
         
    Next rng

End Sub

 

[Green Squirrel]

Try this (not tested).

Sub ImportTBL1()
  
    Dim sourceSheet As Worksheet
    Dim QT As QueryTable
    Dim destCell As Range
    Dim qtResultRange As Range
    Dim TBL As String
    Dim URL As String
    Dim DES As String
    Dim COL As String
  
    Set sourceSheet = Sheet6
    Dim rng As Range:
   
    'Loop through each used cell in row 1
    For Each rng In Sheets("Sheet1").Range("A1", Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft))
    'Dim cel As Range
      
        'For Each cel In rng.Cells   'rng is only one cell. No need to loop through one cell
            TBL = rng.Cells(1, 1)
            URL = rng.Cells(2, 1)
            DES = rng.Cells(3, 1)
            COL = rng.Cells(4, 1)
        'Next cel
            
         With sourceSheet
             Set destCell = .Range(DES)
             On Error Resume Next
             .ListObjects(TBL).Delete
             On Error GoTo 0
         End With
       
         Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=destCell)
       
         With QT
             .RefreshStyle = xlOverwriteCells
             .WebFormatting = xlNone
             .WebSelectionType = xlSpecifiedTables
             .WebTables = COL
             .BackgroundQuery = False
             .Refresh
             Set qtResultRange = .ResultRange
             .Delete
         End With
       
         With destCell
             .Worksheet.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes).Name = TBL
             sourceSheet.ListObjects(TBL).ShowAutoFilterDropDown = False
         End With
        
    Next rng

End Sub

@AlphaFrog THANK YOU THANK YOU!!! Works brilliantly!!!

 

[Green Squirrel]

Try this (not tested).

Sub ImportTBL1()
  
    Dim sourceSheet As Worksheet
    Dim QT As QueryTable
    Dim destCell As Range
    Dim qtResultRange As Range
    Dim TBL As String
    Dim URL As String
    Dim DES As String
    Dim COL As String
  
    Set sourceSheet = Sheet6
    Dim rng As Range:
   
    'Loop through each used cell in row 1
    For Each rng In Sheets("Sheet1").Range("A1", Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft))
    'Dim cel As Range
      
        'For Each cel In rng.Cells   'rng is only one cell. No need to loop through one cell
            TBL = rng.Cells(1, 1)
            URL = rng.Cells(2, 1)
            DES = rng.Cells(3, 1)
            COL = rng.Cells(4, 1)
        'Next cel
            
         With sourceSheet
             Set destCell = .Range(DES)
             On Error Resume Next
             .ListObjects(TBL).Delete
             On Error GoTo 0
         End With
       
         Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=destCell)
       
         With QT
             .RefreshStyle = xlOverwriteCells
             .WebFormatting = xlNone
             .WebSelectionType = xlSpecifiedTables
             .WebTables = COL
             .BackgroundQuery = False
             .Refresh
             Set qtResultRange = .ResultRange
             .Delete
         End With
       
         With destCell
             .Worksheet.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes).Name = TBL
             sourceSheet.ListObjects(TBL).ShowAutoFilterDropDown = False
         End With
        
    Next rng

End Sub

Maybe another small question.

in COL I give in the range where the table needs to come, but this I have to calculate manually. The tables don't have a set amount of rows.
So how can I make that the second table come under the first table, with one row between the two tables. As in the picture.

 

[AlphaFrog]

Sub ImportTBL1()
   
    Dim sourceSheet As Worksheet
    Dim QT As QueryTable
    Dim destCell As Range
    Dim qtResultRange As Range
    Dim TBL As String
    Dim URL As String
    'Dim DES As String
    Dim COL As String
   
    Set sourceSheet = Sheet6
    Dim rng As Range
    
    Set destCell = sourceSheet.Range("B2") 'first Table
    
    'Loop through each used cell in row 1
    For Each rng In Sheets("Sheet1").Range("A1", Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft))
    'Dim cel As Range
       
        'For Each cel In rng.Cells   'rng is only one cell. No need to loop through one cell
            TBL = rng.Cells(1, 1)
            URL = rng.Cells(2, 1)
            COL = rng.Cells(4, 1)
        'Next cel
             
        On Error Resume Next
        sourceSheet.ListObjects(TBL).Delete
        On Error GoTo 0
        
         Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=destCell)
        
         With QT
             .RefreshStyle = xlOverwriteCells
             .WebFormatting = xlNone
             .WebSelectionType = xlSpecifiedTables
             .WebTables = COL
             .BackgroundQuery = False
             .Refresh
             Set qtResultRange = .ResultRange
             .Delete
         End With
        
         With destCell
             .Worksheet.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes).Name = TBL
             sourceSheet.ListObjects(TBL).ShowAutoFilterDropDown = False
         End With
         
         Set destCell = destCell.Offset(sourceSheet.ListObjects(TBL).Range.Rows.Count + 1)
         
    Next rng

End Sub