1004 error- application defined or object defined error and hyperlink weblooping macro question

Question

Here is my web looping macro.  It worked at first and then got this error and now the error won't go away.  Please let me know if I can do anything to fix this.  Also, if one of the cells being imported in the web query is a hyperlink, how could I copy that information while keeping the hyperlink format.

Option Explicit
Sub CharityNavigator2()
'
' tradeking Macro
' Macro recorded 7/3/2008 by areich
'
Dim COMPANYNUMBER As String
Dim RowNum As Long

COMPANYNUMBER = Range("4793").Value
RowNum = 4793

Do Until COMPANYNUMBER = Range("5800").Value
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.charitynavigator.org/index.cfm?bay=search.summary&orgid=" & COMPANYNUMBER & "" _
        , Destination:=Range("AA2"))
        .Name = "index.cfm?bay=search.summary&orgid=12123"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .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

Range("AA19").Select
Selection.Copy
Range("A" & RowNum).Select
ActiveSheet.Paste

Range("AA23").Select
Selection.Copy
Range("D" & RowNum).Select
ActiveSheet.Paste

Range("AA19").Select
Selection.Copy
Range("E" & RowNum).Select
ActiveSheet.Paste

Range("AA20").Select
Selection.Copy
Range("F" & RowNum).Select
ActiveSheet.Paste

Range("AA21").Select
Selection.Copy
Range("G" & RowNum).Select
ActiveSheet.Paste

Range("AA22").Select
Selection.Copy
Range("H" & RowNum).Select
ActiveSheet.Paste

Range("AA134").Select
Selection.Copy
Range("I" & RowNum).Select
ActiveSheet.Paste

Range("AB134").Select
Selection.Copy
Range("J" & RowNum).Select
ActiveSheet.Paste

Range("J" & RowNum).Replace What:= _
        " (The person identified as holding the highest position of management, and therefore who would normally be responsible for carrying out the mission of the charity and leading the organization on a day-to-day basis.)" _
        , Replacement:=" ", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
        False, SearchFormat:=False, ReplaceFormat:=False
Cells.Find(What:= _
        " (The person identified as holding the highest position of management, and therefore who would normally be responsible for carrying out the mission of the charity and leading the organization on a day-to-day basis.)" _
        , After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:= _
        xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) _
        .Activate

RowNum = RowNum + 1
COMPANYNUMBER = Range("C" & RowNum).Value

Loop

ActiveWorkbook.Save

End Sub


Thank you very much