Code Macro - Copier et coller avec hyperlien une feuille sous forme de tableau récapitulatif consolidé

Question

Bonjour,

Débutant sur VBA, je reviens pour une autre probématique à ressoudre :

En fait suivant l'exemple joint,

j'aimerais modifier mes formules macros intégrées dans les lignes "Ajout ligne pour un nouveau sous-détails à créer" de mon tableau récapitulatif (onglet BUDGET ESTXXX).

Je veux qu'à chaque ajout-ligne effectué, ma macro puisse intégrer et coller un hyperlien au niveau des cellules Ax et Bx correspondantes.

Petit exemple du lien recherché avec la ligne B5 "FF XXX" et l'onglet : afin de permettre la création de plusieurs feuilles ayant des hyperliens avec le tableau récap.

---

Private Sub AJOUTERCommande_Click()

  Worksheets("BUDGET ESTXXX").Range("POSTE2").EntireRow.Insert , CopyOrigin:=xlFormatFromRightOrBelow 

Dim numsousdétailsprix As String 

Dim libellésousdétailsprix As String 

Application.ScreenUpdating = False 

On Error Resume Next 

ActiveWorkbook.Sheets("SD prix").Range("L33").ClearContents 

ActiveWorkbook.Sheets("SD prix").Visible = True 

ActiveWorkbook.Sheets("SD prix").Copy After:=Sheets(Sheets.Count) 

ActNm = numsousdétailsprix 

numsousdétailsprix = CodeBox.Text 

Sheets(numsousdétailsprix).Visible = True 

ActiveWorkbook.Sheets("SD prix").Visible = False 

For Each WS In Worksheets 

If WS.Name = numsousdétailsprix Then MsgBox "La feuille existe déjà": Exit Sub 

Next WS

libellésousdétailsprix = DétailBox 

Sheets(libellésousdétailsprix).Visible = True 

ActiveWorkbook.Sheets("SD prix").Visible = False 

If numsousdétailsprix = "" Then 

    Exit Sub 

End If 

If libellésousdétailsprix = "" Then 

    Exit Sub 

End If 

    Application.DisplayAlerts = False 

 Dim i As Integer 

 i = Worksheets("BUDGET ESTXXX").Range("POSTE2").Row - 1 

 Worksheets("BUDGET ESTXXX").Range("A" & i) = numsousdétailsprix 

 Worksheets("BUDGET ESTXXX").Range("B" & i) = libellésousdétailsprix 

 Worksheets("BUDGET ESTXXX").Range("C" & i).FormulaR1C1 = "=INDIRECT(RC[-2]&""!k100"")" 

Application.DisplayAlerts = True 

ActiveSheet.Name = CodeBox.Text 

ActiveSheet.Range("SDPrixn°\_").Value = numsousdétailsprix 

ActiveSheet.Range("\_nomssdétails1").Value = libellésousdétailsprix 

Application.ScreenUpdating = True 

'Vider le userform 

CodeBox.Text = "" 

DétailBox.Text = "" 

'Cacher le userform

AJOUTERCODEBUDGET02.Hide 

End Sub

---

Lien exemple https://www.cjoint.com/c/NJhoWRJ6ypP

Answer 1

Essaie :

Private Sub AJOUTERCommande_Click()

  Worksheets("BUDGET ESTXXX").Range("POSTE2").EntireRow.Insert , CopyOrigin:=xlFormatFromRightOrBelow  
    
Dim numsousdétailsprix As String  
Dim libellésousdétailsprix As String  
Application.ScreenUpdating = False  
On Error Resume Next  
ActiveWorkbook.Sheets("SD prix").Range("L33").ClearContents  
ActiveWorkbook.Sheets("SD prix").Visible = True  
ActiveWorkbook.Sheets("SD prix").Copy After:=Sheets(Sheets.Count)  
ActNm = numsousdétailsprix  
numsousdétailsprix = CodeBox.Text  
Sheets(numsousdétailsprix).Visible = True  
ActiveWorkbook.Sheets("SD prix").Visible = False  
For Each WS In Worksheets  
If WS.Name = numsousdétailsprix Then MsgBox "La feuille existe déjà": Exit Sub  

Next WS
libellésousdétailsprix = DétailBox
Sheets(libellésousdétailsprix).Visible = True
ActiveWorkbook.Sheets("SD prix").Visible = False

If numsousdétailsprix = "" Then  
    Exit Sub  
End If  
If libellésousdétailsprix = "" Then  
    Exit Sub  
End If  
  
    Application.DisplayAlerts = False  
 Dim i As Integer  
 With Worksheets("BUDGET ESTXXX")  
  i = .Range("POSTE2").Row - 1  
  .Range("A" & i) = numsousdétailsprix  
  .Range("B" & i) = libellésousdétailsprix  
  .Range("C" & i).FormulaR1C1 = "=INDIRECT(RC[-2]&""!k100"")"  
  .Hyperlinks.Add .Range("A" & i), Sheets("FF XXX").[A7].Address, , numsousdétailsprix  
 End With  
Application.DisplayAlerts = True  

ActiveSheet.Name = CodeBox.Text  
ActiveSheet.Range("SDPrixn°\_").Value = numsousdétailsprix  
ActiveSheet.Range("\_nomssdétails1").Value = libellésousdétailsprix  
Application.ScreenUpdating = True  
  
'Vider le userform  
CodeBox.Text = ""  
DétailBox.Text = ""  

'Cacher le userform
AJOUTERCODEBUDGET02.Hide

End Sub

Daniel

Answer 2

Cellule A7 de chaque onglet créé correspondant (ou SD créé).

Answer 3

Peux-tu préciser exactement sur quoi doivent pointer les liens des cellules A7 et B7 ? Merci.

Daniel

Answer 4

Bjr M. Danielco,

Déjà merci pour ce retour.

En fait l'option "Ajout ligne pour un nouveau sous-détails à créer" qu'on retouve sur le tableau récapitualtif de l'onglet BUDGET ESTXXX " est une macro qui me permet d'ajouter des lignes à chaque POSTE (des lignes qui sont copiées à partir d'une trame masquée nommé SD prix )

La macro fonctionne déja bien pour l'ajout des lignes et des sous détails corresponadants :

----->>>> J'aimerais juste la modifier en rajoutant un hyperlien entre la ligne ajoutée et le SD correspondant créé.

Autre exemple joint : j'ai créé la ligne tout en jaune "A7:C7" correspondant à l'onglet 100 :

----->>>> j'aimerais qu'un hyperlien se mette en place (intégré sur les cellule A7 & B7) avec l'onglet couleur jaune 100 correspondant à la ligné créée.

>>>>>> Un lien qui se rapproche du raccourci entre la ligne tout en bleu "A5:C5" et l'onglet "FF XXX"

Lien exemple : https://www.cjoint.com/c/NJik7aLEYN7

Answer 5

Bonjour,

Je n'ai pas compris ce que tu veux dire par "Ajout ligne pour un nouveau sous-détails à créer" ?

Daniel