Passer au contenu principal

Comment copier un lien hypertexte uniquement d'une cellule à une autre dans Excel?

Supposons que j'ai une liste de valeurs dans la colonne A et que chaque cellule contient un lien hypertexte différent, maintenant, je veux copier uniquement les liens hypertexte sans texte vers une autre colonne E comme illustré ci-dessous. Il n'y a peut-être pas de moyen direct de résoudre ce travail dans Excel, mais ici, je peux introduire un code VBA pour le gérer.

doc copier le lien hypertexte vers une autre cellule 1

Copiez le lien hypertexte d'une cellule à une autre avec le code VBA


flèche bleue bulle droite Copiez le lien hypertexte d'une cellule à une autre avec le code VBA

Pour copier uniquement les adresses de lien hypertexte sans le texte dans d'autres cellules, le code suivant peut vous rendre service, veuillez comme ceci:

1. Maintenez le ALT + F11 clés pour ouvrir le Microsoft Visual Basic pour applications fenêtre.

2Cliquez sur insérer > Moduleet collez le code suivant dans le Module Fenêtre.

Code VBA: copier le lien hypertexte uniquement d'une cellule à une autre:

Sub CopyHyperlinks()
'Uodateby Extendoffice
    Dim xSRg As Range
    Dim xDRg As Range
    Dim I As Integer
    Dim xAddress As String
    On Error Resume Next
    xAddress = ActiveWindow.RangeSelection.Address
    Set xSRg = Application.InputBox("Please select the original range you want to copy hyperlinks:", "KuTools For Excel", xAddress, , , , , 8)
    If xSRg Is Nothing Then Exit Sub
    Set xDRg = Application.InputBox("Please select the new range you want to paste the hyperlinks only", "KuTools For Excel", , , , , , 8)
    If xDRg Is Nothing Then Exit Sub
    Set xDRg = xDRg(1)
    For I = 1 To xSRg.Count
        If xSRg(I) <> "" And xDRg.Offset(I - 1) <> "" Then
            If xSRg(I).Hyperlinks.Count = 1 Then
                xDRg(I).Hyperlinks.Add xDRg(I), xSRg(I).Hyperlinks(1).Address
            End If
        End If
    Next
End Sub

3. Et puis appuyez sur F5 clé pour exécuter ce code, une boîte de dialogue apparaîtra pour vous rappeler de sélectionner les cellules dont vous souhaitez copier les hyperliens uniquement, voir capture d'écran:

doc copier le lien hypertexte vers une autre cellule 02

4. Et puis cliquez OK, puis sélectionnez les cellules que vous souhaitez coller les hyperlins uniquement dans une autre boîte de dialogue, voir capture d'écran:

doc copier le lien hypertexte vers une autre cellule 03

5. Et les adresses de lien hypertexte ont été copiées des cellules d'origine vers les cellules spécifiées selon vos besoins, voir capture d'écran:

doc copier le lien hypertexte vers une autre cellule 04

Notes: Ce code peut également vous aider à copier les hyperliens d'une feuille vers une autre feuille comme vous le souhaitez.

Meilleurs outils de productivité bureautique

🤖 Aide à l'IA Kutools: Révolutionner l'analyse des données en s'appuyant sur : Exécution intelligente   |  Générer du code  |  Créer des formules personnalisées  |  Analyser les données et générer des graphiques  |  Invoquer les fonctions Kutools...
Caractéristiques populaires: Rechercher, mettre en évidence ou identifier les doublons   |  Supprimer les lignes vides   |  Combinez des colonnes ou des cellules sans perdre de données   |   Tour sans formule 
Super recherche: VSearchup à critères multiples    VSearch à valeurs multiples  |   Recherche virtuelle sur plusieurs feuilles   |   Recherche floue ....
Liste déroulante avancée: Créez rapidement une liste déroulante   |  Liste déroulante dépendante   |  Liste déroulante à sélection multiple ....
Gestionnaire de colonnes: Ajouter un nombre spécifique de colonnes  |  Déplacer les colonnes  |  Basculer l'état de visibilité des colonnes masquées  |  Comparer les plages et les colonnes 
Caractéristiques en vedette: Mise au point de la grille   |  Voir Design   |   Grande barre de formule    Gestionnaire de classeurs et de feuilles   |  Centre de ressources (Texte automatique)   |  Sélecteur de date   |  Combiner des feuilles de travail   |  Crypter/déchiffrer les cellules    Envoyer des e-mails par liste   |  Super filtre   |   Filtre spécial (filtre gras/italique/barré...) ...
Les 15 meilleurs ensembles d'outils12 Texte Outils (Ajouter du texte, Supprimer les caractères, ...)   |   50+ Graphique Types (Diagramme de Gantt, ...)   |   40+ Pratique Formules (Calculer l'âge en fonction de l'anniversaire, ...)   |   19 Insertion Outils (Insérer le code QR, Insérer une image à partir du chemin, ...)   |   12 Conversion Outils (Nombres en mots, Conversion des devises, ...)   |   7 Fusionner et fractionner Outils (Lignes de combinaison avancées, Cellules divisés, ...)   |   ... et plus

Améliorez vos compétences Excel avec Kutools for Excel et faites l'expérience d'une efficacité comme jamais auparavant. Kutools for Excel offre plus de 300 fonctionnalités avancées pour augmenter la productivité et gagner du temps.  Cliquez ici pour obtenir la fonctionnalité dont vous avez le plus besoin...

Description


Office Tab apporte une interface à onglets à Office et facilite grandement votre travail

  • Activer l'édition et la lecture par onglets dans Word, Excel, PowerPoint, Publisher, Access, Visio et Project.
  • Ouvrez et créez plusieurs documents dans de nouveaux onglets de la même fenêtre, plutôt que dans de nouvelles fenêtres.
  • Augmente votre productivité de 50% et réduit des centaines de clics de souris chaque jour!

 

Comments (13)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
I made the following edits to work for my use case:
Sub CopyHyperlinks()
'Uodateby Extendoffice
Dim xSRg As Range
Dim xDRg As Range
Dim I As Integer
Dim xAddress As String
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xSRg = Application.InputBox("Please select the original range you want to copy hyperlinks:", "KuTools For Excel", xAddress, , , , , 8)
If xSRg Is Nothing Then Exit Sub
Set xDRg = Application.InputBox("Please select the new range you want to paste the hyperlinks only", "KuTools For Excel", , , , , , 8)
If xDRg Is Nothing Then Exit Sub
Set xDRg = xDRg(1)
For I = 1 To xSRg.Count
If xSRg(I).Hyperlinks(1).Address <> "" Or xSRg(I).Hyperlinks(1).SubAddress <> "" Then
If xSRg(I).Hyperlinks.Count = 1 Then
xDRg(I).Hyperlinks.Add Anchor:=xDRg(I), _
Address:=xSRg(I).Hyperlinks(1).Address, _
SubAddress:=xSRg(I).Hyperlinks(1).SubAddress
'ScreenTip:=xSRg(I).Hyperlinks(1).ScreenTip, _
'TextToDisplay:=xSRg(I).Hyperlinks(1).TextToDisplay
End If
End If
Next
End Sub
This comment was minimized by the moderator on the site
OK, so you won't publish my comment - which is fair. But if you want me to register and log in, then you need to show me solutions that work, because (on the basis of one non-working instance) I've seen nothing to persuade me that there's any value in registering.
This comment was minimized by the moderator on the site
Doesn't work for me; does the fact that I'm still using Excel 2007 matter?
This comment was minimized by the moderator on the site
This is awesome and it works. I love copy&pasting other people's code :D
This comment was minimized by the moderator on the site
This didn't work for me either.
This comment was minimized by the moderator on the site
Lets say in your cell A1 is hyperlink, so to get the path of the hyperlink just create formula like below:
>> (MID((FORMULATEXT(A1));(FIND("(";(FORMULATEXT(A1)))+2);(FIND(";";(FORMULATEXT(A1)))-1)-(FIND("(";(FORMULATEXT(A1)))+2))) <<
This comment was minimized by the moderator on the site
Doesn't work.
This comment was minimized by the moderator on the site
Love it. Thank you so muchoooo.
Love From Dominican Republic :)
This comment was minimized by the moderator on the site
Doesn't work.
This comment was minimized by the moderator on the site
hello.. what if i want to copy the hyperlink through vlookup? i already have the formula but when i click the the hyperlink it "cannot open specied file" will appear.

Please help me
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations