VBA in Excel web data fetching loop

Question

 Sub Button1_Click()

 Set ws = ActiveWorkbook.Sheets("Sheet1")
 Set ws2 = Worksheets("Sheet2")

Range("A2:P100").ClearContents

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www6.landings.com/cgi-bin/nph-search_nnr?  pass=193800885&&nnumber=" & ws2.Range("E2").Value _
, Destination:=Range("$G$4"))
.Name = "nph-search_nnr?pass=193800885&&nnumber=22A"
.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 = "18"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False

 'Copy to Another sheet

     ws.Range("I7").Copy
     ws2.Range("A20000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

     ws.Range("I8").Copy
     ws2.Range("B20000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

     ws.Range("I6").Copy
     ws2.Range("C20000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

     ws.Range("I5").Copy
     ws2.Range("D20000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues



   Worksheets("Sheet2").Columns("A:P").AutoFit



 End With

 End Sub

I wrote that code with help of recorded macro, it gets certain info from the website, I need to automate that process and after clicking Button_1 it should loop through all existing cell values of column E in Worksheets("Sheet2")(except the header).I am guessing between each loop it should wait until data are fully retrieved and loaded, that coding is too much for me to handle yet...

Simply in each looped run part of web address ( ws2.Range("E2").Value ) has to be replaced with next row in column in Sheet2 column E

Answer 1

This should do it.

Update: I added Application.ScreenUpdating = False to speed up the macro.

Option Explicit

Sub Button1_Click()
    Dim lastRow As Long, x As Long

    Application.ScreenUpdating = False

    With Worksheets("Sheet2")

        lastRow = .Range("D" & Rows.Count).End(xlUp).Row

        For x = 2 To lastRow

            RequeryLandings .Cells(x, "E")

        Next

        .Columns("A:P").AutoFit

    End With

    Application.ScreenUpdating = True

End Sub


Sub RequeryLandings(address As String)

    Dim ws As Worksheet

    Set ws = ActiveWorkbook.Sheets("Sheet1")

    Range("A2:P100").ClearContents

    With ActiveSheet.QueryTables.Add(Connection:= _
                                     "URL;http://www6.landings.com/cgi-bin/nph-search_nnr?  pass=193800885&&nnumber=" & address _
                                     , Destination:=Range("$G$4"))
        .Name = "nph-search_nnr?pass=193800885&&nnumber=22A"
        .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 = "18"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False

        DoEvents

        'Copy to Another sheet

        With Worksheets("Sheet2")
            .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = ws.Range("I7")
            .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = ws.Range("I8")
            .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = ws.Range("I6")
            .Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = ws.Range("I5")
        End With
    End With

End Sub