Function GetURL(cell As Range, Optional default_value As Variant)
'Lists the Hyperlink Address for a Given Cell
'If cell does not contain a hyperlink, return default_value
If (cell.Range("A1").Hyperlinks.Count <> 1) Then
GetURL = default_value
Else
GetURL = cell.Range("A1").Hyperlinks(1).Address
End If
End Function
Iets sneller, voor als je een hele kolom moet doen. Selecteer de kolom waarin de hyperlinks staan. Zorg wel dat je rechts van die kolom geen data hebt staan want dat bereik wordt overschreven.
Sub ExtractHL()
Dim HLink As Hyperlink
For Each HLink In Selection.Hyperlinks
HLink.Range.Offset(0, 1).Value = HLink.Address
Next
End Sub
Je hebt een hele kolom vol met urls maar die zijn platte tekst. Zoiets:
https://www.google.nl/?gws_rd=ssl
https://www.msn.com/nl-nl/?ocid=iehp
https://subscene.com/
https://www.addic7ed.com/
Etc.
Om een hyperlink van al die urls te maken, selecteer ze allemaal en voer de macro uit.
Sub Verander_In_Hyperlinks()
Dim rngCell As Range
For Each rngCell In Intersect(Selection, ActiveSheet.UsedRange)
If rngCell <> "" Then
ActiveSheet.Hyperlinks.Add rngCell, rngCell.Value
End If
Next
End Sub