Hjælp til macro - loop stopper ikke, når næste celle er tom.

Hej alle,

Min macro stopper ikke automatisk, når min celle er to. Kan i hjælpe?

Macro:

"Sub test_macro()
   
    Dim conString As String
    Dim conName As String
    Dim x As String
    Dim i As Integer

    Worksheets("Sheet1").Activate
   
    i = 1
    Do While Cells(i, 1).Value <> ""
   
    x = Worksheets("Sheet1").Cells(i, 1)

       
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = x
 
 
        conString = "URL;http://finance.yahoo.com/q/is?s=" & x & "+Income+Statement&annual"
        conName = "ks?s=" & x & "+Income+Statement&annual"
       
        With ActiveSheet.QueryTables.Add(Connection:=conString, Destination:=Range("$A$1"))
            .Name = conName
            .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 = """yfncsubtit"",8,10,11,13,15,17,19,21,23"
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
 
    i = i + 1
 

    Loop 

End Sub"

I skal forestille jer, at der i Sheet1 kolonne A står et antal navne, hvor macroen skulle stoppe, når den kommer til bunden = cellen er tom.

Det gør den ikke og jeg får en fejlmelding.

"Run-time error '1004':

Application-defined or object-defined error".

Kan nogle hjælpe?