find hyperlink(s) kopier og sæt ind (makro)

hvad er der i andre celler der ikke er hyperlinks? Er de blanke eller er der tekst?

Nogle er der tekst i andre er blanke, men fuldstændig tilfældig. Det er ikke sådan at hyperlinket altid er efter en blank celle

hyperlinkene som jeg vil flytte over i ark2, må gerne bare være værdien eller teksten fra den celle hyperlinket er i. Altså det behøver ikke at være et link til at trykke på.

Hvis dine hyperlinks alle står med www kan du lave en almindelig sortering.
Så vil de være lige til at COPY/PASTE.

Nedenstående makro finder alle hyperlinks i i A-kolonnen og skriver de relevante cellers tekstindhold til A-kolonnen i Ark2. Makroen forudsætter at den pågældende kolonne (i Ark2) er tom, når makroen afspilles. Ellers overskrives det indhold, der allerede findes i kolonnen. Eventuelle hyperlinks i andre kolonner medtages ikke i Ark2

Sub FindHyperLink()
    Dim i As Integer
    Dim HypNavn As String
    i = 2
    For Each h In Worksheets(1).Columns("a:a").Hyperlinks
        HypNavn = h.Name
        Worksheets(2).Range("a" & i).Value = HypNavn
        i = i + 1
    Next
End Sub

I kolonne aa10 skriver du Hvis(find(X;a10)>0;aa9+1;aa9)
Ikolonne ab10 skriver du: Hvis(aa10>aa9;aa10;"")
i kolonne ac10 skriver du Hvis(aa10>0;a10;"") ´
de tre celler kopieres ned i arket
I ark2 skriver du i kolonne a10 1
I kolonne a1 og resten af kolonnen a10+1
i kolonne b10 skriver du: lopslag(a10;ark1!$ab$10:$ac$200;2;falsk)

X kan enten være "@" (emailadresser) eller "www" eller "http"

Lige hvad jeg skulle bruge jkrons mange tak

Velbekomme :-)