hi i need some help with looping web querys

[fordprefect225]

take a number from colum A (001-650) paste it into a cell and then run a webquery

the trouble i have is it won't loop

this is the code

Sub Macro2()
Dim VAL As String
 Do
 
 ActiveCell.Offset(1, 0).Select
 Range("E2").PasteSpecial
 
 Range("E1").Copy
    Range("G1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("G8:H8").ClearContents
    Range("G8").Font.Italic = True
    Range("G7").Select
    VAL = Range("G1").Value
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & VAL, Destination:=Range("$G$7"))
    .Name = "008.shtml"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "6,18,19,20"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
       End With
      
     
 
    Loop Until IsEmpty(ActiveCell.Offset(0, 1))
      
End Sub