XL 2016 Création Lien hypertexte dynamique.

[Collins]

Bonjour à tous

Je copie un tableau d'une feuille "support" et ai la possibilité de le coller (par macro) sur chaque feuille sélectionnée.(Commerce_1 ou Commerce_2)
Et je n'arrive pas à créer ce lien qui se retrouve donc sur ses feuilles pour aller en haut de chaque page sélectionnée.
J'ai fait un fichier exemple ou j'ai mis toutes les explications.
Merci beaucoup.

 

[job75]

Bonjour Collins,

Voyez le fichier joint et cette macro dans le code de la feuille "Support" :

Private Sub Worksheet_Deactivate()
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
Dim T As Range
Set T = Sheets("Support").[A4].CurrentRegion 'à adapter
If MsgBox("Voulez-vous copier-coller le tableau '" & T.Parent.Name & "'!" & T.Address(0, 0) & " ?", 36) = 7 Then Exit Sub
With ActiveSheet
    With .Cells(.UsedRange.Row + .UsedRange.Rows.Count + 1, 2)
        T.Copy .Cells(1, 0)
        .Formula = "=HYPERLINK(""#'" & .Parent.Name & "'!A1"",""HAUT"")"
        .Font.ColorIndex = 3 'rouge
        .Font.Bold = True 'gras
    End With
End With
End Sub

A+

 

[Collins]

Bonjour Job

Je te remercie
Je viens de voir ta méthode. Elle est super à condition de n'avoir que le même tableau à copier/coller. Elle me servira surement un jour.
Mais comme j'ai fait en sorte pour aller vite dans ce fichier essai que de ne faire qu'un tableau à copier/coller, hors dans mon fichier réel j'ai 2 tableaux, un pour des ACHATS et 1 pour des VENTES. Et je sélectionne soit dans commerce_1 soit dans commerce_2 la cellule ou je veux faire le collage du tableau ACHAT ou le tableau VENTE. C'est à dire que j'ai à coller plusieurs ACHATS à la suite ou plusieurs VENTES à la suite. Bien sur j'ai 2 bouton de commande. Et les 2 tableaux n'ont pas la même structure (Nb ligne, intitulés...)
Et c'est pour ça qu'il me faudrait un moyen (lien hypertexte ou autre) pour remonter en haut de la page une fois collé le tableau (et rempli). Parce qu'en haut j'ai tout le suivi à chaque page.
@+

 

[Collins]

Re

J'ai oublié de dire qu'en dessous des tableau collés. A chaque fois je rajoute des lignes automatiquement par macro pour pouvoir avoir la place car j'ai des écritures en dessous.

 

[job75]

Avec ce fichier (2) on choisit la feuille de destination, la macro du bouton Transférer :

Sub Transferer()
If [B2] = "" Then Exit Sub
Dim T As Range, nlig
Set T = Sheets("Support").[A4].CurrentRegion 'à adapter
nlig = 5 'nombre de ligne de décalage, à adapter
With Sheets(CStr([B2]))
    With .Cells(.UsedRange.Row + .UsedRange.Rows.Count + nlig, 2)
        T.Copy .Cells(1, 0)
        .Formula = "=HYPERLINK(""#'" & .Parent.Name & "'!A1"",""HAUT"")"
        .Font.ColorIndex = 3 'rouge
        .Font.Bold = True 'gras
    End With
    .Activate 'facultatif
End With
End Sub

La variable nlig détermine le décalage avec la dernière ligne précédente.

A+

 

[Collins]

Re

Désolé ce n'est pas encore çà car les valeurs se collent en dessous des écritures. et les tableaux que je veux rajouter je les intercale en choisissant la cellule, en la sélectionnant et là je fais mon copié/collé soit du tableau ACHAT soit du tableau VENTE. et ces 2 la je vais les copier sur la feuille "support"

 

[job75]

je fais mon copié/collé soit du tableau ACHAT soit du tableau VENTE. et ces 2 la je vais les copier sur la feuille "support"

Il n'y a qu'un seul tableau… Vous voulez dire qu'il faut le filtrer sur la colonne B (achat/vente) ?

Si c'est le cas vous auriez pu le préciser dès le début !!!

 

[Collins]

Re

Non je ne filtre pas.
Dans la feuil "Support" j'ai 2 tableaux : 1 pour "achat", 1 pour "Vente".
E t sur chaque feuille j'ai 2 boutons de Cde soit je rajoute "tableau achat" soit "tableau vente"
Et en fonction sur une ou l'autre des feuilles (commerce_1, commerce_2) je sélectionne la cellule ou doit se placer le tableau que je vais copier
J'ai des valeurs au dessus et au dessous de l'endroit ou je dois collé ces tableaux.
Si besoin, demain je compléterai mon fichier en #1 pour le mettre dans la même situation.
Merci encore pour votre temps pris.

 

[job75]

Tout ça ne semble pas cohérent :

- dans votre fichier il n'y a qu'un seul tableau

- s'il y en avait 2 la colonne B achat/vente ne servirait à rien.

Dans ce fichier (3) la cellule de destination peut être choisie :

Sub Transferer()
If [B2] = "" Then Exit Sub
Dim T As Range, dest As Range
Set T = Sheets("Support").[A4].CurrentRegion 'à adapter
Sheets(CStr([B2])).Activate
On Error Resume Next
Set dest = Application.InputBox("Sélectionnez la cellule de destination :", "Cellule", Type:=8)
On Error GoTo 0
If dest Is Nothing Then T.Parent.Activate: Exit Sub
T.Copy dest(1)
With dest(1, 2)
    .Formula = "=HYPERLINK(""#'" & .Parent.Name & "'!A1"",""HAUT"")"
    .Font.ColorIndex = 3 'rouge
    .Font.Bold = True 'gras
End With
End Sub

 

[Collins]

Re
Oui effectivement je n'aurais pas du mettre achat/vente. ça a enduit en erreur. Je pensais faire un truc rapide.
Avec cette dernière solution ça marche bien pour 1 tableau à rajouter. Je peux effectivement bien le coller ou je veux.
Je vais modifier le 1er fichier envoyé en #1 et rajouter les 2 boutons de Cde et les 2 tableaux (achat et vente). Et la çà ressemblera mieux à mon fichier réel.
Merci mais je ne voudrai pas abuser de votre temps.
Bonne soirée et à demain

 

[job75]

Fichier (4) avec 2 tableaux à copier et 2 boutons par feuille :

Sub Transferer()
Dim T1 As Range, T2 As Range, dest As Range
Set T1 = Sheets("Support").[A4].CurrentRegion 'à adapter
Set T2 = Sheets("Support").[F4].CurrentRegion 'à adapter
On Error Resume Next
Set dest = Application.InputBox("Sélectionnez la cellule de destination :", "Cellule", Type:=8)
On Error GoTo 0
If dest Is Nothing Then Exit Sub
IIf(ActiveSheet.DrawingObjects(Application.Caller).Text = "ACHAT", T1, T2).Copy dest(1)
With dest(1, 2)
    .Formula = "=HYPERLINK(""#'" & .Parent.Name & "'!A1"",""HAUT"")"
    .Font.ColorIndex = 3 'rouge
    .Font.Bold = True 'gras
End With
End Sub

Bonne nuit.

 

[job75]

Bonjour Collins, le forum,

Encore une solution dans ce fichier (5) avec le double-clic et un UserForm.

Le code dans ThisWorkbook :

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
With Sheets("Support")
    If Sh.Name = .Name Then Exit Sub
    .[A4].CurrentRegion.Name = "ACHAT" 'plage nommée
    .[F4].CurrentRegion.Name = "VENTE" 'plage nommée
End With
Cancel = True
UserForm1.Show
End Sub

Le code de l'UserForm :

Private Sub CommandButton1_Click() 'ACHAT
[ACHAT].Copy ActiveCell
Lien
Unload Me
End Sub

Private Sub CommandButton2_Click() 'VENTE
[VENTE].Copy ActiveCell
Lien
Unload Me
End Sub

Private Sub CommandButton3_Click() 'Annuler
Unload Me
End Sub

Sub Lien()
With ActiveCell(1, 2)
    .Formula = "=HYPERLINK(""#'" & ActiveSheet.Name & "'!A1"",""HAUT"")"
    .Font.ColorIndex = 3 'rouge
    .Font.Bold = True 'gras
End With
End Sub

A+

 

[Collins]

Bonjour Job75, Bonjour à tous,

Merci beaucoup pour ce travail. Cette dernière version du #11 va m'aller super bien je vais vite l'adapter.
Pendant que j'écrivais vous avez mis une version #12, Je la regarderai avec attention.
C'est vraiment sympa pour ce que vous avez fait. En + mon fichier réel a bien évolué avec déjà votre aide et beaucoup d'autres.
Bonne journée
@+