Web Scraping

I am trying to pull the 2014 assessed values from my county assessors website and put them into a spreadsheet. I have the parcel numbers of the properties that I need and I would like to enter the assessed values next to the parcel numbers. The code below is what I have so far. I'm able to get the information from the table on the website to import into the spreadsheet but getting the right cell to copy into the cell next to the right parcel number and loop correctly has stumped me. If there is a better way of doing this where I don't need to import the entire table and then delete it every time let me know. I'm not too familiar with web programming. I have also attached a sample of parcel numbers. Thanks!

Sub Scrape()
'
' Scrape Macro
'

'
    For i = 1 To 2
        ThisParcel = ActiveSheet.Cells(i, 1)
        ThisValue = ActiveSheet.Cells(i, 2)
        
    
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://epip.co.pierce.wa.us/cfapps/atr/epip/taxvalue.cfm?parcel=" & ThisParcel, Destination:=Range("$C$2"))
        .Name = "taxvalue.cfm?parcel=" & ThisParcel
        .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 = "10"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        
    End With
    
        Range("F3").Select
        Selection.Copy
        ThisValue.Select
        ActiveSheet.Paste
        Range("C2:J11").Select
        Application.CutCopyMode = False
        Selection.QueryTable.Delete
        Selection.ClearContents
        Range("B2").Select
    
    Next i
    
End Sub

Try

Sub Scrape()
'
' Scrape Macro
'

'
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        ThisParcel = ActiveSheet.Cells(i, 1)
        ThisValue = ActiveSheet.Cells(i, 2)
        
    
        With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;http://epip.co.pierce.wa.us/cfapps/atr/epip/taxvalue.cfm?parcel=" & ThisParcel, Destination:=Range("$C$2"))
            .Name = "taxvalue.cfm?parcel=" & ThisParcel
            .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 = "10"
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
            
        End With
    
        ActiveSheet.Cells(i, 2) = Range("F3")
        Columns("C:Z").Clear
            
    Next i
    
End Sub
Sub Macro3()
'
' Macro3 Macro
'

'
    Range("F3").Select
    Selection.Copy
    Range("B1").Select
    ActiveSheet.Paste
    Range("D2:K11").Select
    Application.CutCopyMode = False
    Selection.QueryTable.Delete
    Selection.ClearContents
    Range("B2").Select
End Sub

That works well. One problem though. Parcel numbers in this county are 10 digits long. Often the parcel number starts with a 0. (See example file) When the web query enters the number it is leaving off the 0. The web site does not recognize the parcel numbers so it's skipping the parcel and not returning a value. I know this is a separate issue... but related. Any ideas?

Try

ThisParcel = Left("0000000000", 10 - Len(ActiveSheet.Cells(i, 1))) & ActiveSheet.Cells(i, 1)