excel - Running VBA script with multiple URL's in one go

Question

I've managed to build a vba script that gets data form a website table. Everything works just the way I want it to work. But I need multiple tables and each time the website or table name needs to be different.

As you can see below in the script I first get table 10 from the website, put it in Cell B2 and call it LT BE1 Home In the second sub I'm calling table 11 from the website, put it in Cell B22 (This is one cell below the previous table) and call it LT BE1 Away. In both cases the URL stays the same

Now I want to do repeat this process for 10 other URL's. So the URL, the destination and table name needs to change each time.

How do I go about this? Do I create 20 (2 tables from 10 different URL's) subs or is there another, more automated way to do this?

Public Sub ImportTBLHome()

    Dim destCell As Range
    Dim QT As QueryTable
    Dim qtResultRange As Range
    Dim URL As String
    Dim sourceSheet As Worksheet
    Dim TBL As String
    Dim sFormula As String
    
    Set sourceSheet = Sheet2
    
    TBL = "LT BE1 Home"
    URL = "https://www.soccerstats.com/homeaway.asp?league=belgium"
    
    With sourceSheet
        Set destCell = .Range("B2")
        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 = "10"
        .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

Public Sub ImportTBLAway()

    Dim destCell As Range
    Dim QT As QueryTable
    Dim qtResultRange As Range
    Dim URL As String
    Dim sourceSheet As Worksheet
    Dim TBL As String
    Dim sFormula As String
    
    Set sourceSheet = Sheet2
    
    TBL = "LT BE1 Away"
    URL = "https://www.soccerstats.com/homeaway.asp?league=belgium"
    
    With sourceSheet
        Set destCell = .Range("B22")
        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 = "11"
        .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

Answer 1

等待大神答复