copier des cellules avec leur lien hypertexteRésolu

Question

Bonjour a tous,

je vais vous expliquer mon problème.

sur une feuille 1 j'ai deux colonnes, la première avec du texte et des liens hypertextes, la seconde avec des noms ( exemple: toto1,toto1,toto2,toto1,toto2....)
Le but de ma macro est de classer sur une autre feuille la colonne 1 ( feuille1) en fonction de la colonne2.
D'abord tout les toto1 puis tous les toto2 .... .

Jusque la j'ai réussi en ce qui concerne le texte. Mais je voudrais maintenant pouvoir copier les liens hypertextes des cellules lorsque je les recopie dans la feuille 2.

Est ce que quelqu'un sait comment on fait?
Si oui, pourriez vous me donner la solution.

Merci rox

Rox74 · Accepted Answer

bonjour

j'ai résolu mon problème.

code

Set mc = Sheets("feuil2").Range("G1")              ' Placement du curceur


i = 1
h = 2
Do                                  ' debut de boucle




    If mc = Z Then                  ' si la case mc vaut la valeur de Z alors
             
    Worksheets("feuil2").Rows(i).Copy   'copy ligne
    Worksheets("feuil3").Activate
    Worksheets("feuil3").Rows(h).Activate  'selectionne ligne feuille3
     ActiveSheet.Paste                                    'colle
              
h = h + 1      ' on descend d'une ligne dans la feuille 3 pour la prochaine ecriture
    End If         ' fin condition


    If mc.Value = "" Then  ' si la case mc vaut rien alors


        Exit Do             ' on quitte la boucle


    End If                  ' fin condition


i = i + 1                   ' on ingrémente de 1 la valeur de i
Set mc = mc.Offset(1, 0)    ' le curseur descend d'une ligne dans la feuille 2


Loop                         'retour au debut de la boucle

bonne journée
rox

BzhRico · Answer

Bonjour,

Si j'ai bien compris ton besoin, c'est d'avoir tes deux colonnes de recopié dans la deuxième feuille, mais triées sur la première colonne. Alors assaie ça :

    Sheets("Feuil1").Columns("A:B").Copy
    With Sheets("Feuil2")
       .Range("A1").Paste
       Application.CutCopyMode = False
       .Columns("A:B").Sort Key1:= _
           .Range("A1") ,Order1:=xlAscending, Header:=xlGuess, _
           OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
           DataOption1:=xlSortNormal
   End With

Conseil : fait le directement sous Excel en enregistrant les commandes, pour retrouver ton code en VBA.

Rox74 · Answer

bonsoir,

Je voudrais tout d'abord que vous m'excusiez pour l'énoncer de mon probleme. J'ai voulu le simplier et je pense que je vous ai envoyé dans une mauvaise direction. 

voici ce que j'ai dans ma feuille 2 

date              nom article                 site           nom projet
x                 Y (lien hypertexte)      toto1           W (lien hypertexte)
x1                 Y1 (lien hypertexte)      toto2          W1 (lien hypertexte)
x2                 Y2 (lien hypertexte)      toto1           W2 (lien hypertexte)

voici ce que je veux dans ma feuille 3

x                 Y (lien hypertexte)      toto1           W (lien hypertexte)
x2                 Y2(lien hypertexte)      toto1           W2 (lien hypertexte)

Or avec mon code que j'ai, je n'ai pas les lien hypertexte. Et c'est ceque je veux rajouter dans mon code.

mon code:
Public Sub client()


Sheets("feuil2").Activate   'selectionner la feuille 2


Dim i As Integer                ' déclaration des variables
Dim h As Integer
Dim mc As Range
Dim Z As String

Set mc = Sheets("feuil2").Range("G1")              ' Placement du curceur


i = 1
h = 2
Do                                  ' debut de boucle




    If mc = Z Then                  ' si la case mc vaut la valeur de Z alors
        
        Sheets("Feuil3").Rows(h).Value = Sheets("Feuil2").Rows(i).Value     'la ligne h de la feuille 3 vaut la ligne i de la feuille 2


h = h + 1      ' on descend d'une ligne dans la feuille 3 pour la prochaine ecriture
    End If         ' fin condition


    If mc.Value = "" Then  ' si la case mc vaut rien alors


        Exit Do             ' on quitte la boucle


    End If                  ' fin condition


i = i + 1                   ' on ingrémente de 1 la valeur de i
Set mc = mc.Offset(1, 0)    ' le curseur descend d'une ligne dans la feuille 2


Loop                         'retour au debut de la boucle

end sub
(z est une variable définie par une textbox  ex toto1
G est la colone site )

Dans mon code c'est cette ligne qui me sert a copier:
 Sheets("Feuil3").Rows(h).Value = Sheets("Feuil2").Rows(i).Value 

Or le . value ne prend pas en compte les liens hypertextes.

ma question est donc: par quoi remplacer le .value? ou keske je dois rajouter pour prendre en compte les liens hypertextes?

merci de votre aide


rox

Rox74 · Answer

re

dsl  ca a tout décalé

voici l'idée de la feuille 2

date   nom art   site   proj
X        Y           T      W
X1     Y1          S      W1
X2      Y2         T      W2

ce sont des liens 

T = toto1
S=toto2

BzhRico · Answer

Re-bonjour,

Dsl pour le retard, mais je vois que tu as réussit.
Sinon, pour information ... le lien HTML est stocké dans le propriété Hyperlinks
Je pense qu'il n'est pas possible d'utiliser la commande sur une ligne entière, pour recopier des adresses html différentes.

Donc tu peux tester, en plus de la copie de valeur, quelque chose comme ça :

Sheets("Feuil3").Hyperlinks.Add Sheets("Feuil3").Rows(h), Sheets("Feuil2").Rows(i).Hyperlinks(1).Address

Autre chose, essai de remplacer tes 3 lignes :
    Worksheets("feuil3").Activate
    Worksheets("feuil3").Rows(h).Activate
    ActiveSheet.Paste
Par : Worksheets("feuil3").Rows(h).Paste
Cela devrait passer et eviter des bascules d'onglet à l'écran.
Pour gagner encore plus de rappidité, essaye :
avant la boucle     ...     Application.ScreenUpdating = False
ne pas oublier à la fin ... Application.ScreenUpdating = True

Rox74 · Answer

Bonjour bzhrico

J'ai essayé les bouts de code que vous m'avez passé et malheureusement ils ne veulent pas fonctionner. J'ai essayé de les trifouiller un peu mais rien.
Donc je vais rester sur mon code.

Par contre je vais utiliser le sceenUpdating qui me fait gagner un peu de temps.

Merci pour votre aide

Bonne journée

RoX

Copier des cellules avec leur lien hypertexte

6 réponses

Votre réponse

Discussions similaires