VBA to scrape website page into a single cell in excel

[zack01]

Hello,
I am still picking on my VBA but not there yet. I am trying to work on a vba code that will open a webpage from a cell in excel scrape into a formatted text and place into a single cell in the same worksheet. The pages i am trying to grab are not the same in structure.
After searching on the web i was able to review codes from other people and put pieces together to work. the problem is that what i have works some what, but the pages that is pulled in excel comes in with the formatting and merge cells are not able to be handled. Also the process is slow when run which keeps my system tied up, making it unable to do other site.

Please see attached code and any help that io can get will be deeply appreciated. thank

code:
1. links are put into E of excel sheet
2. webpage destination is in column P
3. I have a search word in G1 that goes through the data in P and if it exist returns a Yes in column K.

Thank you

Public strsearch As String

Sub SearchSite()
   Range("E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    For j = Selection.Row To Selection.Row + Selection.Rows.Count - 1

' Get the URL
       theurl = Range("E" & j)
       If theurl = "" Then GoTo NextRow

    ' Fill the query table
            With ActiveSheet.QueryTables.Add(Connection:="URL;" & theurl, Destination:=Range("P" & j))
            .Name = "NewsQuery"
            .AdjustColumnWidth = False
            .RefreshStyle = xlOverwriteCells
            .TablesOnlyFromHTML = False
            .Refresh BackgroundQuery:=False
            .SaveData = False

End With
combineCellsIntoOne Range("P" & j)

' Search the Query Table for the Search Term
strsearch = Range("G1")
bottomrow = Range("P" & Rows.Count).End(xlUp).Row

For i = j To bottomrow
If InStr(Range("P" & i), stresearch) <> 0 Then
   Range("K" & j) = "YES"
Exit For
End If
Range("K" & j) = "YES"
Next i

NextRow:
Next j

End Sub

Sub combineCellsIntoOne(dest As Range)
Dim lastRow As Long
lastRow = Cells(Rows.Count, dest.Column).End(xlUp).Row

Dim i As Long

For i = dest.Row + 1 To lastRow
dest.Value = dest.Value & " " & Cells(i, dest.Column).Value
Application.DisplayAlerts = flash
Cells(i, dest.Column).Delete 'Clear ‘Contents
Application.DisplayAlerts = True

Next i

End Sub