Listing + renvoi dynamique

[topo]

Bonjour à tous,

Je suis en train de bosser sur un listing client pour le boulot, et j'ai un peu de mal à dynamiser mes fiches clients. voici le fichier de travail sur lequel je travaille (mot de passe : SESAME) :
- dans l'onglet "aliste", j'ai les références de base clients qui que quoi dont où comment etc. où je saisie mes infos,
- dans les onglets suivants, une fiche plus détaillée de chaque client. Par exemple, mon onglet 1 reprend des infos de ma base + d'autres infos à remplir.

Quelque questions donc:
Comment fait-on pour créer un onglet par de client et surtout comment fait-on apparaître le lien hypertexte comme pour l'onglet "1"?
Comment fait-on pour que les onglets créés ait tous le même forme (celle de l'onglet "1") mais avec les bonnes infos clients?

Pour la création d'onglet, j'ai quelque chose, malheureusement, ça me colle les infos sur la première ligne et je ne sais pas trop ce que je dois enlever :

Option Explicit

Dim Col_Fiche As Collection
Dim Derligne As Long
Dim DerCol As Byte
Dim L As Long, Ligne As Long
Dim Tabtemp As Variant
Dim Tabrecup() As Variant
Dim x As Long
Dim it As Byte, Col As Byte
Dim Sht As String
Dim New_Sht As Worksheet
Sub Transfert_Fiche()
Set Col_Fiche = New Collection
it = 0
With Worksheets("aliste")
 Derligne = .Range("A65536").End(xlUp).Row
  DerCol = .Range("IV1").End(xlToLeft).Column
  Tabtemp = .Range(.Cells(2, 1), .Cells(Derligne, DerCol)).Value
     On Error Resume Next
       For L = 1 To UBound(Tabtemp, 1)
         Col_Fiche.Add Tabtemp(L, 1), CStr(Tabtemp(L, 1))
          If Err.Number = 0 Then
            it = it + 1
              x = -1
               Sht = Col_Fiche(it)
             For Ligne = 1 To UBound(Tabtemp, 1)
               If Tabtemp(Ligne, 1) = Sht Then
                 x = x + 1
                 ReDim Preserve Tabrecup(DerCol, x)
                   For Col = 1 To UBound(Tabtemp, 2)
                     Tabrecup(Col - 1, x) = Tabtemp(Ligne, Col)
                   Next
               End If
             
             Next
Application.ScreenUpdating = False
         If Sheet_Exists(Sht) = False Then
           Set New_Sht = Worksheets.Add
            With New_Sht
                .Name = Sht
                .Move After:=Sheets(Sheets.Count)
          Worksheets("aliste").Rows(1).Copy .Rows(1)
            End With
         End If
             With Worksheets(Sht)
               Derligne = .Range("A65536").End(xlUp).Row + 1
                 .Range(.Cells(2, 1), .Cells(Derligne, 11)).ClearContents
                 .Cells(2, 1).Resize(UBound(Tabrecup, 2) + 1, UBound(Tabrecup, 1)) = Application.Transpose(Tabrecup)
             End With
               Erase Tabrecup
                        
        
       End If
       Err.Clear
       Next
     On Error GoTo 0
End With
Worksheets("aliste").Activate
Application.ScreenUpdating = True
End Sub
Function Sheet_Exists(Sheet_Name As String) As Boolean
Dim wsheet
Application.Volatile
On Error Resume Next
Set wsheet = Sheets(Sheet_Name)
Sheet_Exists = wsheet.Name = Sheet_Name
On Error GoTo 0
End Function

Merci beaucoup, parce que là, je patauge !!!

 

[jp14]

Re : Listing + renvoi dynamique

Bonsoir

Ci joint le fichier avec une procédure.
Algorithme simplifié
Si une feuille dont le nom se trouve en colonne a( 1,2...) n'existe pas
Copie de la feuille "model".
Les données sont transférées de la première feuille vers la feuille crée.
Pour cela il faut mettre dans la cellule du tableau le caractère £ suivi de la colonne ou se trouve la donnée a inscrire dans cette cellule.
L'avantage de cette technique c'est de permettre la modification du dessin du model sans modifier la macro.
Concernant les colonnes G et j si la macro reconnait une adresse mail ou un url transformation de la donnée en lien Hypertexte.

A tester

JP

 

[topo]

Re : Listing + renvoi dynamique

Bonjour JP,

Merci ! ça marche super bien, l'onglet model est vraiment une idée brillante !

Mais j'ai besoin d'un dernier complément pour les liens hypertexte : J'aurais aussi besoin d'avoir un lien hypertexte qui navigue directement d'onglet en onglet dans la colonne A : la fiche 2 nous amène sur l'onglet 2 etc.

Merci, c'est vrai utile comme macro !

 

[jp14]

Re : Listing + renvoi dynamique

Bonsoir

Ci dessous le code avec cette fonctionnalité, remplace le code existant

Private Sub lienhypertexte(lig As Long)
Dim val1 As String
With Worksheets("aliste")
val1 = .Range("G" & lig).Value
If val1 <> "" And InStr(val1, "@") > 0 Then
    .Range("G" & lig).Hyperlinks.Add Anchor:=.Range("G" & lig), Address:= _
        "mailto:" & val1, TextToDisplay:=val1

End If
val1 = .Range("j" & lig).Value
If val1 <> "" And InStr(UCase(val1), "WWW") > 0 And InStr(val1, ".") > 0 Then
    .Range("j" & lig).Hyperlinks.Add Anchor:=.Range("j" & lig), Address:= _
        "http://" & val1, TextToDisplay:=val1

End If

val1 = .Range("A" & lig)
    ActiveSheet.Hyperlinks.Add Anchor:=.Range("A" & lig), Address:="", SubAddress:= _
       "'" & val1 & "'!A1"

End With
End Sub

A tester

 

[topo]

Re : Listing + renvoi dynamique

Merci JP,

Tout marche parfaitement ! je vais pouvoir commencer mon travail de titan grâce à toi !

ce site est vraiment génial !