Listedeki web sayfalarından sırayla verileri alma

[kalhan]

Merhaba üstat lar.
Excel de hücrelerde alt altta yazılmış listedeki web siitelerini sırayla excel sayfasına almak istiyorum. Her biri için kod yazmaktansa bunu bir döngü ile yapabilmem mümkünmüdüür.

Kodda kırmızı ve kalın yazılmış bölgeyi listeden sıra ile alması gerekiyor.


makro şu şekilde

Sub AAAA()
'
' Makro1 Makro
'

'
    Sheets("HamData").Select
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://report.paragaranti.com/malitablo/MaliTablolar_3.aspx?hisse=ACSEL", _
        Destination:=Range("$A$1"))
        .Name = "MaliTablolar_3.aspx?hisse=ACSEL"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://report.paragaranti.com/rasyonet_performans_getiri_haber_t.asp?Hisse=ACSEL" _
        , Destination:=Range("$A$130"))
        .Name = "rasyonet_performans_getiri_haber_t.asp?Hisse=LOGO"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Sheets("Convert").Select
    Range("B3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("İslenmisData").Select
    Range("B3").Select
    Selection.End(xlDown).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B3").Select
    Selection.End(xlDown).Offset(1, 0).Select
    Sheets("HamData").Select
    Columns("A:O").Select
    Selection.QueryTable.Delete
    Selection.ClearContents
    Range("A1").Select
    Sheets("Convert").Select
    Range("B3").Select
    Sheets("İslenmisData").Select