Green Squirrel
New Member
- Joined
- Jan 9, 2021
- Messages
- 25
- Office Version
- 365
- Platform
- MacOS
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
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
VBA Code:
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