Copier un lien hypertexte d'une cellule à une autre

Question

Bonjour, 

J'ai un fichier excel avec plusieurs onglets. Un des onglets est "Habitants" et l'autre "Récap Habitants". Dans l'onglet "Habitants" dans certaines cellules j'ai un lien hypertexte m'envoyant vers une autre feuille excel contenant les details de cet "Habitant".

J'ai actuellement une macro qui me permet d'avoir dans mon onglet "Recap Habitants" tous les details de l'onglet "Habitants", à chaque fois que j'ai un nouvel habitant je peux via ma macro rapporter tous les details dans l'onglet "Recap Habitants".

Par contre je ne sais pas quel code mettre dans ma macro pour que celle-ci me copie dans l'onglet "Recap habitants" également le lien hypertexte qu'il pourrait y avoir dans certaines cellules de l'onglet "Habitants".

pour faire simple
onglet "Habitants" cellule F2 = il y a un lien actif
quand j'utilise ma macro je voudrais
onglet "Recap Habitants" cellule F2= le lien & qu'il soit = ment actif

Merci beaucoup !

Patrice33740 · Answer

Bonjour,

Tout simplement :
  Worksheets("Habitants").[F2].Copy _
    Destination:=Worksheets("Recap Habitants").[F2]

Patrice33740 · Answer

Bonjour VM,

J'aurais écrit ceci :
Option Explicit
Sub VM()
Dim o As Range    'Origine
Dim d As Range    'Destination
Dim t As Boolean  'Test

'dernière cellule utilisée en colonne 1 de Habitants
  Set o = Worksheets("Habitants").Columns(1).Find("*", , , , , xlPrevious)
  'première cellule libre en colonne 1 de Recap Habitants
  Set d = Worksheets("Recap Habitants").Columns(1).Find("*", , , , , xlPrevious).Offset(1)
  
  Do While o.Row >= 10
    'tester la colonne F
    t = o.Offset(0, 5).Value <> ""
    If t Then
       'copier la ligne
       o.EntireRow.Copy d
       'cellule de destination suivante
       Set d = d.Offset(1)
    End If
    'cellule d'origine suivante
    Set o = o.Offset(-1)
    'supprimer la ligne précédente (si elle vient d'être copiée)
    If t Then o.EntireRow.Offset(1).Delete
  Loop

End Sub

Patrice33740 · Answer

Bonjour,

Voici le même code (avec des lignes moins longues):
Option Explicit
Sub VM()
Dim o As Range    'Origine
Dim d As Range    'Destination
Dim t As Boolean  'Test

'dernière cellule utilisée en colonne 1 de Habitants
  Set o = Worksheets("Habitants").Columns(1) _
          .Find("*", , , , , xlPrevious)
  'première cellule libre en colonne 1 de Recap Habitants
  Set d = Worksheets("Recap Habitants").Columns(1) _
          .Find("*", , , , , xlPrevious).Offset(1)
  
  Do While o.Row >= 10
    'tester la colonne F
    t = o.Offset(0, 5).Value <> ""
    If t Then
       'copier la ligne
       o.EntireRow.Copy d
       'cellule de destination suivante
       Set d = d.Offset(1)
    End If
    'cellule d'origine suivante
    Set o = o.Offset(-1)
    'supprimer la ligne précédente (si elle vient d'être copiée)
    If t Then o.EntireRow.Offset(1).Delete
  Loop

End Sub

Copier un lien hypertexte d'une cellule à une autre

3 réponses

Discussions similaires

Newsletters