Microsoft 365 Ajout d'onglet par VBA et entête de colonnes

Roseline · 28 Mai 2024

Bonjour,
J'ai un gros fichier contenant beaucoup de données. J'aurais besoin d'aide en ce qui touche ma VBA.

Mon premier onglet "Suivi des dossiers" comporte beaucoup de colonnes et j'ai un autre onglet nommé "donnée" qui me sert de base pour mes menus déroulants.

Dans un premier temps je dois ajouter des colonnes au début et elles doivent être nommées Villes - Types d'achat et # factures et une autre Résultats et peu plus loin. Jusque là tout va bien.

Où j'ai de la difficulté

Premièrement:
Insérer le menu déroulant par vba dans la colonne de la Ville et dans la colonne Type d'achat que je viens d'ajouter. Ce menu doit s'ajouter automatiquement à chaque fois que je clique sur le bouton ajouter colonnes car je vais devoir en ajouter d'autres à différentes périodes et avec des menus déroulants différents aussi. De plus si j'ai besoin de changer la colonne en format Date par exemple, je suis incapable de le faire dans ma vba.

Deuxièmement:
J'ai automatisé la création d'onglets pour chacun des employés nommé dans la colonne E mais je suis incapable d'ajouter automatiquement l'entête des colonnes dans chacun des onglets et de faire le transfert des données automatiquement pour chaque employé dans chacun son onglet en fonction de son nom dans la colonne E. la commande que j'ai mis le fait bien mais pour un employé seulement, je suis incapable de le faire pour tous les employés inscrits dans la feuille "suivi de dossiers"

J'ai joint un fichier pour une meilleure compréhension.

Merci de votre précieuse aide et bonne journée

AtTheOne · 1 Juin 2024

Bonjour à toutes & à tous, bonjour @Roseline
Bon, j'ai recréé ton fichier avec 2 Subs et la fonction FeuilleExiste (j'ai aussi j'ai recopié ton userform)

Pour la fonction, je te propose une méthode plus rapide, surtout si tu as beaucoup de feuilles dans ton classeur. (idée de Laurent LONGRE)

La macro de création de colonne inclus les validations de données et, à titre d'exemple, une mise en forme pour des dates.
Les validations de données utilisent des noms définis pointant vers les tableaux structurées de l'onglet données.

La macro de création et transfert de données vers les feuilles Employés utilise des tableaux VBA pour les données (plus rapides que l’accès aux cellules) et des dictionnaires pour identifier les lignes à transférer pour chaque employé (Scripting.Dictionary).

Pour ces 2 Subs une constante lgn1 définie la 1ere ligne du tableau de données.

Code Fonction FeuilleExiste(Nom)

VB:

'______________________________________________________
'FONCTION DE VERIFICATION DE L'EXISTENCE D'UNE FEUILLE
'======================================================

Function FeuilleExiste(Nom$)
   
     Dim sh As Worksheet
   
     On Error Resume Next
     Set sh = ThisWorkbook.Worksheets(Nom) 'tente d'accéder à la feuille "Nom"
     On Error GoTo 0
   
     FeuilleExiste = Not sh Is Nothing     'la feuille "Nom" existe si sh n'est pas Nothing
   
End Function

Code Sub CréerColonnes()

VB:

Const lgn1 = 4 'ligne de départ

'______________________________________________________
'AJOUTER DES COLONNES A LA FEUILLE "Suivi des dossiers"
'======================================================
Sub CréerColonnes()
   
     Dim wSh As Worksheet, derlgn As Long
     Application.ScreenUpdating = False
   
     Set wSh = ShSuivi
     With wSh
     'Effacer les filtres
          If .FilterMode Then .ShowAllData
          .AutoFilterMode = False
   
          derlgn = .Cells(.Rows.Count, 1).End(xlUp).Row
          If derlgn < lgn1 Then Exit Sub
         
     'Insertion d'une colonne en 2ième position
          .Columns(2).Insert
          .Cells(lgn1, 2) = "Résultat"
         
     'Insertion de 3 colonnes en tête
          .Columns(1).Resize(, 3).Insert
         
          .Cells(lgn1, 1) = "Ville"
          With .Range(.Cells(lgn1 + 1, 1), .Cells(derlgn, 1)).Validation   'de la 1ère ligne de saisie à la dernière (col A)
               .Delete
               .Add Type:=xlValidateList, Formula1:="=chx_Ville"           'utilisation du nom défini chx_ville
          End With
         
          .Cells(lgn1, 2) = "Type d'achat"
          With .Range(.Cells(lgn1 + 1, 2), .Cells(derlgn, 2)).Validation   'de la 1ère ligne de saisie à la dernière (col B)
               .Delete
               .Add Type:=xlValidateList, Formula1:="=chx_Type"            'utilisation du nom défini chx_type
          End With
         
          .Cells(lgn1, 3) = "# facture"
         
     'Mettre un format (jjj jj/mm/aaa) par exemple en colonne 4
          .Range(.Cells(lgn1 + 1, 4), .Cells(derlgn, 4)).NumberFormatLocal = "jjj jj/mm/aaaa"
         
     'Activer les filtres
          .Cells(lgn1, 1).AutoFilter
         
     End With
     Application.ScreenUpdating = True
   
End Sub

code Sub CréerFeuillesEmployés()

VB:

'________________________________________________________
'CREATION DES FEUILLES EMPLOYE AVEC TRANSFERT DES DONNEES
'========================================================

Sub CréerFeuillesEmployés()

     Dim wShSce As Worksheet, wSh As Worksheet
     Dim Dico As Object, DicLgn As Object
    
     Application.ScreenUpdating = False
    
     Set Dico = CreateObject("Scripting.Dictionary")
     Set DicLgn = CreateObject("Scripting.Dictionary")
    
     'Lecture de la feuille source (ici "Suivi des dossiers")
     Set wShSce = ShSuivi
     With wShSce
          If .FilterMode Then .ShowAllData
          ColEmployé = WorksheetFunction.Match("Employé", .Rows(lgn1), 0)
          tbdonnées = .Cells(lgn1, 1).CurrentRegion
     End With
     NbLgnSce = UBound(tbdonnées, 1)
     nbcol = UBound(tbdonnées, 2)
    
     ReDim TitresCol(1 To 1, 1 To nbcol)     'titre des colonnes à copier
     For j = 1 To nbcol
          TitresCol(1, j) = tbdonnées(1, j)
     Next
    
     'Collecte dans un dictionnaire des employés et des lignes qui leur correspondent
     DicLgn("1") = 1
     For i = 2 To UBound(tbdonnées)
          If tbdonnées(i, ColEmployé) <> "" Then Dico(tbdonnées(i, ColEmployé)) = Dico(tbdonnées(i, ColEmployé)) & "¤" & i
          DicLgn(CStr(i)) = i
     Next i

     clefs = Dico.Keys: valeurs = Dico.Items
     n = -1
     For Each clef In clefs
          n = n + 1
          If FeuilleExiste(CStr(clef)) Then  '=>ne pas tenter de créer une feuile qui existe déjà
               MsgBox Title:="Employé " & clef, prompt:="Une feuille à ce nom existe déjà"
          Else
               Set wSh = ThisWorkbook.Worksheets.Add(before:=shDonnées)    'Création de la feuille Employé
               With wSh
                    .Name = clef                                           'Attribution du nom
                    .Cells(lgn1, 1).Resize(1, nbcol).Value = TitresCol     'Coller les titres de colonne
                    LgnàCopier = Split(valeurs(n), "¤")                    'Identifier les lignes à copier (l'élément 0 est vide et ne sera pas lu)
                    nblgn = UBound(LgnàCopier)
                    ReDim tbres(1 To nblgn, 1 To nbcol)                    'Créer un tableau avec les valeurs à copier
                    For i = 1 To nblgn
                         For j = 1 To nbcol
                              tbres(i, j) = tbdonnées(LgnàCopier(i), j)
                         Next j
                         DicLgn.Remove LgnàCopier(i)                       'Retire cette ligne du dictionnaire des lignes à conserver
                    Next i
                    .Cells(lgn1 + 1, 1).Resize(nblgn, nbcol).Value = tbres 'Coller les valeur dans la feuille Employé
                    wShSce.Rows(lgn1).Copy
                    .Rows(lgn1).PasteSpecial Paste:=xlPasteColumnWidths
                    If Not .AutoFilterMode Then .Cells(lgn1, 1).AutoFilter
               End With
          End If
     Next
    
     lgnAconserver = DicLgn.Count                      'nbre de lignes à conserver restantes
    
     'Constitution d'une tableau des données à conserver
     ReDim tbres(1 To lgnAconserver, 1 To nbcol)
     clefs = DicLgn.Keys: valeurs = DicLgn.Items
     For i = 1 To lgnAconserver
          l = valeurs(i - 1)
          For j = 1 To nbcol
               tbres(i, j) = tbdonnées(l, j)
          Next
     Next
    
     'Effacer les anciennes données et coller les données à conserver
     With wShSce
          .Cells(lgn1, 1).CurrentRegion.ClearContents
          .Cells(lgn1, 1).Resize(lgnAconserver, nbcol) = tbres
          If Not .AutoFilterMode Then .Cells(lgn1, 1).AutoFilter
          .Activate
     End With
     Application.ScreenUpdating = True

End Sub

Voilà, voir le fichier joint
A bientôt

Roseline · 3 Juin 2024

AtTheOne à dit:

Bonjour à toutes & à tous, bonjour @Roseline
Bon, j'ai recréé ton fichier avec 2 Subs et la fonction FeuilleExiste (j'ai aussi j'ai recopié ton userform)

Pour la fonction, je te propose une méthode plus rapide, surtout si tu as beaucoup de feuilles dans ton classeur. (idée de Laurent LONGRE)

La macro de création de colonne inclus les validations de données et, à titre d'exemple, une mise en forme pour des dates.
Les validations de données utilisent des noms définis pointant vers les tableaux structurées de l'onglet données.

La macro de création et transfert de données vers les feuilles Employés utilise des tableaux VBA pour les données (plus rapides que l’accès aux cellules) et des dictionnaires pour identifier les lignes à transférer pour chaque employé (Scripting.Dictionary).

Pour ces 2 Subs une constante lgn1 définie la 1ere ligne du tableau de données.

Code Fonction FeuilleExiste(Nom)

VB:

'______________________________________________________
'FONCTION DE VERIFICATION DE L'EXISTENCE D'UNE FEUILLE
'======================================================

Function FeuilleExiste(Nom$)
  
     Dim sh As Worksheet
  
     On Error Resume Next
     Set sh = ThisWorkbook.Worksheets(Nom) 'tente d'accéder à la feuille "Nom"
     On Error GoTo 0
  
     FeuilleExiste = Not sh Is Nothing     'la feuille "Nom" existe si sh n'est pas Nothing
  
End Function

Code Sub CréerColonnes()

VB:

Const lgn1 = 4 'ligne de départ

'______________________________________________________
'AJOUTER DES COLONNES A LA FEUILLE "Suivi des dossiers"
'======================================================
Sub CréerColonnes()
  
     Dim wSh As Worksheet, derlgn As Long
     Application.ScreenUpdating = False
  
     Set wSh = ShSuivi
     With wSh
     'Effacer les filtres
          If .FilterMode Then .ShowAllData
          .AutoFilterMode = False
  
          derlgn = .Cells(.Rows.Count, 1).End(xlUp).Row
          If derlgn < lgn1 Then Exit Sub
        
     'Insertion d'une colonne en 2ième position
          .Columns(2).Insert
          .Cells(lgn1, 2) = "Résultat"
        
     'Insertion de 3 colonnes en tête
          .Columns(1).Resize(, 3).Insert
        
          .Cells(lgn1, 1) = "Ville"
          With .Range(.Cells(lgn1 + 1, 1), .Cells(derlgn, 1)).Validation   'de la 1ère ligne de saisie à la dernière (col A)
               .Delete
               .Add Type:=xlValidateList, Formula1:="=chx_Ville"           'utilisation du nom défini chx_ville
          End With
        
          .Cells(lgn1, 2) = "Type d'achat"
          With .Range(.Cells(lgn1 + 1, 2), .Cells(derlgn, 2)).Validation   'de la 1ère ligne de saisie à la dernière (col B)
               .Delete
               .Add Type:=xlValidateList, Formula1:="=chx_Type"            'utilisation du nom défini chx_type
          End With
        
          .Cells(lgn1, 3) = "# facture"
        
     'Mettre un format (jjj jj/mm/aaa) par exemple en colonne 4
          .Range(.Cells(lgn1 + 1, 4), .Cells(derlgn, 4)).NumberFormatLocal = "jjj jj/mm/aaaa"
        
     'Activer les filtres
          .Cells(lgn1, 1).AutoFilter
        
     End With
     Application.ScreenUpdating = True
  
End Sub

code Sub CréerFeuillesEmployés()

VB:

'________________________________________________________
'CREATION DES FEUILLES EMPLOYE AVEC TRANSFERT DES DONNEES
'========================================================

Sub CréerFeuillesEmployés()

     Dim wShSce As Worksheet, wSh As Worksheet
     Dim Dico As Object, DicLgn As Object
   
     Application.ScreenUpdating = False
   
     Set Dico = CreateObject("Scripting.Dictionary")
     Set DicLgn = CreateObject("Scripting.Dictionary")
   
     'Lecture de la feuille source (ici "Suivi des dossiers")
     Set wShSce = ShSuivi
     With wShSce
          If .FilterMode Then .ShowAllData
          ColEmployé = WorksheetFunction.Match("Employé", .Rows(lgn1), 0)
          tbdonnées = .Cells(lgn1, 1).CurrentRegion
     End With
     NbLgnSce = UBound(tbdonnées, 1)
     nbcol = UBound(tbdonnées, 2)
   
     ReDim TitresCol(1 To 1, 1 To nbcol)     'titre des colonnes à copier
     For j = 1 To nbcol
          TitresCol(1, j) = tbdonnées(1, j)
     Next
   
     'Collecte dans un dictionnaire des employés et des lignes qui leur correspondent
     DicLgn("1") = 1
     For i = 2 To UBound(tbdonnées)
          If tbdonnées(i, ColEmployé) <> "" Then Dico(tbdonnées(i, ColEmployé)) = Dico(tbdonnées(i, ColEmployé)) & "¤" & i
          DicLgn(CStr(i)) = i
     Next i

     clefs = Dico.Keys: valeurs = Dico.Items
     n = -1
     For Each clef In clefs
          n = n + 1
          If FeuilleExiste(CStr(clef)) Then  '=>ne pas tenter de créer une feuile qui existe déjà
               MsgBox Title:="Employé " & clef, prompt:="Une feuille à ce nom existe déjà"
          Else
               Set wSh = ThisWorkbook.Worksheets.Add(before:=shDonnées)    'Création de la feuille Employé
               With wSh
                    .Name = clef                                           'Attribution du nom
                    .Cells(lgn1, 1).Resize(1, nbcol).Value = TitresCol     'Coller les titres de colonne
                    LgnàCopier = Split(valeurs(n), "¤")                    'Identifier les lignes à copier (l'élément 0 est vide et ne sera pas lu)
                    nblgn = UBound(LgnàCopier)
                    ReDim tbres(1 To nblgn, 1 To nbcol)                    'Créer un tableau avec les valeurs à copier
                    For i = 1 To nblgn
                         For j = 1 To nbcol
                              tbres(i, j) = tbdonnées(LgnàCopier(i), j)
                         Next j
                         DicLgn.Remove LgnàCopier(i)                       'Retire cette ligne du dictionnaire des lignes à conserver
                    Next i
                    .Cells(lgn1 + 1, 1).Resize(nblgn, nbcol).Value = tbres 'Coller les valeur dans la feuille Employé
                    wShSce.Rows(lgn1).Copy
                    .Rows(lgn1).PasteSpecial Paste:=xlPasteColumnWidths
                    If Not .AutoFilterMode Then .Cells(lgn1, 1).AutoFilter
               End With
          End If
     Next
   
     lgnAconserver = DicLgn.Count                      'nbre de lignes à conserver restantes
   
     'Constitution d'une tableau des données à conserver
     ReDim tbres(1 To lgnAconserver, 1 To nbcol)
     clefs = DicLgn.Keys: valeurs = DicLgn.Items
     For i = 1 To lgnAconserver
          l = valeurs(i - 1)
          For j = 1 To nbcol
               tbres(i, j) = tbdonnées(l, j)
          Next
     Next
   
     'Effacer les anciennes données et coller les données à conserver
     With wShSce
          .Cells(lgn1, 1).CurrentRegion.ClearContents
          .Cells(lgn1, 1).Resize(lgnAconserver, nbcol) = tbres
          If Not .AutoFilterMode Then .Cells(lgn1, 1).AutoFilter
          .Activate
     End With
     Application.ScreenUpdating = True

End Sub

Voilà, voir le fichier joint
A bientôt

Bonjour,
Watatowwww c'est en plein cela que je voulais. Ho que je suis contente de ton aide. C'est tellement apprécié.

Milles Mercis

AtTheOne · 3 Juin 2024

Bonjour,
Merci pour le retour !

Roseline · 3 Juin 2024

AtTheOne à dit:

Bonjour à toutes & à tous, bonjour @Roseline
Bon, j'ai recréé ton fichier avec 2 Subs et la fonction FeuilleExiste (j'ai aussi j'ai recopié ton userform)

Pour la fonction, je te propose une méthode plus rapide, surtout si tu as beaucoup de feuilles dans ton classeur. (idée de Laurent LONGRE)

La macro de création de colonne inclus les validations de données et, à titre d'exemple, une mise en forme pour des dates.
Les validations de données utilisent des noms définis pointant vers les tableaux structurées de l'onglet données.

La macro de création et transfert de données vers les feuilles Employés utilise des tableaux VBA pour les données (plus rapides que l’accès aux cellules) et des dictionnaires pour identifier les lignes à transférer pour chaque employé (Scripting.Dictionary).

Pour ces 2 Subs une constante lgn1 définie la 1ere ligne du tableau de données.

Code Fonction FeuilleExiste(Nom)

VB:

'______________________________________________________
'FONCTION DE VERIFICATION DE L'EXISTENCE D'UNE FEUILLE
'======================================================

Function FeuilleExiste(Nom$)
  
     Dim sh As Worksheet
  
     On Error Resume Next
     Set sh = ThisWorkbook.Worksheets(Nom) 'tente d'accéder à la feuille "Nom"
     On Error GoTo 0
  
     FeuilleExiste = Not sh Is Nothing     'la feuille "Nom" existe si sh n'est pas Nothing
  
End Function

Code Sub CréerColonnes()

VB:

Const lgn1 = 4 'ligne de départ

'______________________________________________________
'AJOUTER DES COLONNES A LA FEUILLE "Suivi des dossiers"
'======================================================
Sub CréerColonnes()
  
     Dim wSh As Worksheet, derlgn As Long
     Application.ScreenUpdating = False
  
     Set wSh = ShSuivi
     With wSh
     'Effacer les filtres
          If .FilterMode Then .ShowAllData
          .AutoFilterMode = False
  
          derlgn = .Cells(.Rows.Count, 1).End(xlUp).Row
          If derlgn < lgn1 Then Exit Sub
        
     'Insertion d'une colonne en 2ième position
          .Columns(2).Insert
          .Cells(lgn1, 2) = "Résultat"
        
     'Insertion de 3 colonnes en tête
          .Columns(1).Resize(, 3).Insert
        
          .Cells(lgn1, 1) = "Ville"
          With .Range(.Cells(lgn1 + 1, 1), .Cells(derlgn, 1)).Validation   'de la 1ère ligne de saisie à la dernière (col A)
               .Delete
               .Add Type:=xlValidateList, Formula1:="=chx_Ville"           'utilisation du nom défini chx_ville
          End With
        
          .Cells(lgn1, 2) = "Type d'achat"
          With .Range(.Cells(lgn1 + 1, 2), .Cells(derlgn, 2)).Validation   'de la 1ère ligne de saisie à la dernière (col B)
               .Delete
               .Add Type:=xlValidateList, Formula1:="=chx_Type"            'utilisation du nom défini chx_type
          End With
        
          .Cells(lgn1, 3) = "# facture"
        
     'Mettre un format (jjj jj/mm/aaa) par exemple en colonne 4
          .Range(.Cells(lgn1 + 1, 4), .Cells(derlgn, 4)).NumberFormatLocal = "jjj jj/mm/aaaa"
        
     'Activer les filtres
          .Cells(lgn1, 1).AutoFilter
        
     End With
     Application.ScreenUpdating = True
  
End Sub

code Sub CréerFeuillesEmployés()

VB:

'________________________________________________________
'CREATION DES FEUILLES EMPLOYE AVEC TRANSFERT DES DONNEES
'========================================================

Sub CréerFeuillesEmployés()

     Dim wShSce As Worksheet, wSh As Worksheet
     Dim Dico As Object, DicLgn As Object
   
     Application.ScreenUpdating = False
   
     Set Dico = CreateObject("Scripting.Dictionary")
     Set DicLgn = CreateObject("Scripting.Dictionary")
   
     'Lecture de la feuille source (ici "Suivi des dossiers")
     Set wShSce = ShSuivi
     With wShSce
          If .FilterMode Then .ShowAllData
          ColEmployé = WorksheetFunction.Match("Employé", .Rows(lgn1), 0)
          tbdonnées = .Cells(lgn1, 1).CurrentRegion
     End With
     NbLgnSce = UBound(tbdonnées, 1)
     nbcol = UBound(tbdonnées, 2)
   
     ReDim TitresCol(1 To 1, 1 To nbcol)     'titre des colonnes à copier
     For j = 1 To nbcol
          TitresCol(1, j) = tbdonnées(1, j)
     Next
   
     'Collecte dans un dictionnaire des employés et des lignes qui leur correspondent
     DicLgn("1") = 1
     For i = 2 To UBound(tbdonnées)
          If tbdonnées(i, ColEmployé) <> "" Then Dico(tbdonnées(i, ColEmployé)) = Dico(tbdonnées(i, ColEmployé)) & "¤" & i
          DicLgn(CStr(i)) = i
     Next i

     clefs = Dico.Keys: valeurs = Dico.Items
     n = -1
     For Each clef In clefs
          n = n + 1
          If FeuilleExiste(CStr(clef)) Then  '=>ne pas tenter de créer une feuile qui existe déjà
               MsgBox Title:="Employé " & clef, prompt:="Une feuille à ce nom existe déjà"
          Else
               Set wSh = ThisWorkbook.Worksheets.Add(before:=shDonnées)    'Création de la feuille Employé
               With wSh
                    .Name = clef                                           'Attribution du nom
                    .Cells(lgn1, 1).Resize(1, nbcol).Value = TitresCol     'Coller les titres de colonne
                    LgnàCopier = Split(valeurs(n), "¤")                    'Identifier les lignes à copier (l'élément 0 est vide et ne sera pas lu)
                    nblgn = UBound(LgnàCopier)
                    ReDim tbres(1 To nblgn, 1 To nbcol)                    'Créer un tableau avec les valeurs à copier
                    For i = 1 To nblgn
                         For j = 1 To nbcol
                              tbres(i, j) = tbdonnées(LgnàCopier(i), j)
                         Next j
                         DicLgn.Remove LgnàCopier(i)                       'Retire cette ligne du dictionnaire des lignes à conserver
                    Next i
                    .Cells(lgn1 + 1, 1).Resize(nblgn, nbcol).Value = tbres 'Coller les valeur dans la feuille Employé
                    wShSce.Rows(lgn1).Copy
                    .Rows(lgn1).PasteSpecial Paste:=xlPasteColumnWidths
                    If Not .AutoFilterMode Then .Cells(lgn1, 1).AutoFilter
               End With
          End If
     Next
   
     lgnAconserver = DicLgn.Count                      'nbre de lignes à conserver restantes
   
     'Constitution d'une tableau des données à conserver
     ReDim tbres(1 To lgnAconserver, 1 To nbcol)
     clefs = DicLgn.Keys: valeurs = DicLgn.Items
     For i = 1 To lgnAconserver
          l = valeurs(i - 1)
          For j = 1 To nbcol
               tbres(i, j) = tbdonnées(l, j)
          Next
     Next
   
     'Effacer les anciennes données et coller les données à conserver
     With wShSce
          .Cells(lgn1, 1).CurrentRegion.ClearContents
          .Cells(lgn1, 1).Resize(lgnAconserver, nbcol) = tbres
          If Not .AutoFilterMode Then .Cells(lgn1, 1).AutoFilter
          .Activate
     End With
     Application.ScreenUpdating = True

End Sub

Voilà, voir le fichier joint
A bientôt

Rebonjour,
J'ai une dernière question, si l'onglet de mon employé est déjà existant mais que je veux transférer les nouvelles données sans créer un autre onglet, comment je peux ajouter cela à la VBA
Merci

Roseline · 3 Juin 2024

AtTheOne à dit:
Bonjour,
Merci pour le retour !

Rebonjour,
J'ai une dernière question, si l'onglet de mon employé est déjà existant mais que je veux transférer les nouvelles données sans créer un autre onglet, comment je peux ajouter cela à la VBA et quand je crée les nouveaux onglets, les menus déroulant disparaissent dans les onglets mais il faudrait qu'il reste

Merci

AtTheOne · 3 Juin 2024

Bonjour à toutes & à tous, bonjour @Roseline

Roseline à dit:
si l'onglet de mon employé est déjà existant mais que je veux transférer les nouvelles données sans créer un autre onglet, comment je peux ajouter cela à la VBA

Je vais faire le transfert dans la feuille existante quand elle existe, mais juste une question :
Faut-il ajouter les lignes transférées à la fin des feuilles préexistantes (conserver les anciennes données) ou supprimer les anciens transfert et recommencer à la ligne 2 ?

Roseline à dit:
quand je crée les nouveaux onglets, les menus déroulant disparaissent

Oups !

J'ai oublié les validation de données dans les nouveaux onglets !

Je reprends le code VBA dès que tu me réponds sur l'écrasement ou non des anciennes données ...*
A bientôt

Roseline · 3 Juin 2024

AtTheOne à dit:
Bonjour à toutes & à tous, bonjour @Roseline

Je vais faire le transfert dans la feuille existante quand elle existe, mais juste une question :
Faut-il ajouter les lignes transférées à la fin des feuilles préexistantes (conserver les anciennes données) ou supprimer les anciens transfert et recommencer à la ligne 2 ?

Oups ! J'ai oublié les validation de données dans les nouveaux onglets !

Je reprends le code VBA dès que tu me réponds sur l'écrasement ou non des anciennes données ...*
A bientôt

Allo, aucun écrasement d'anciennes données. C'est justement si je dois en ajouter. Les données déjà là doivent demeurer. Aussi, j'aimerais copier les boutons dans tous les onglets en même temps que la création des onglets. Je pourrai ajuster selon mon besoin. Tu es super gentil de m'aider

AtTheOne · 3 Juin 2024

Re

Roseline à dit:
j'aimerais copier les boutons dans tous les onglets en même temps que la création des onglets. Je pourrai ajuster selon mon besoin

De quelles actions à tu besoin dans les feuilles "Employé" ?

Pas la création des feuilles j'imagine
Pas l'ajout des colonnes, à moins que tu ne l'aies oubliée avant de créer tes feuilles "Employé" (Oups j'ai oublié ! tant pis je le fais après ...)
L'import, pour faire des import de ligne individuellement sur certaines feuilles "Employé"

A tout de suite ...

Roseline · 3 Juin 2024

AtTheOne à dit:
Re

De quelles actions à tu besoin dans les feuilles "Employé" ?

Pas la création des feuilles j'imagine

Pas l'ajout des colonnes, à moins que tu ne l'aies oubliée avant de créer tes feuilles "Employé" (Oups j'ai oublié ! tant pis je le fais après ...)

L'import, pour faire des import de ligne individuellement sur certaines feuilles "Employé"

A tout de suite ...

Allo,
Lorsque les feuilles des employés sont crées:

Je veux être capable de transférer à nouveau des données de ma feuille principale vers les onglets qui viennent d'être crée et si l'onglet n'est pas créer de le créer. Il se peut que je sois obligé d'ajouter des transactions et de les transférer à nouveau dans l'onglet de l'employé. Donc si il est déjà créer, il fait juste ajouter les nouvelles lignes tout simplement.
Dans chacun des onglets crées pour chaque employé je vais ajouter un bouton pour copier une ligne. Ce que j'ai de la difficulté à faire c'est de faire en sorte qu'à la création de l'onglet du nouvel employé, le bouton pour copier une ligne s'insère automatiquement dans la première ligne du fichier.

AtTheOne · 4 Juin 2024

Re, il se fait tard !

En pièce jointe le classeur modifier.

La macro de création et transfert de lignes vérifie l'existence de la feuille "Employé" et la crée éventuellement.
Le transfert les données s'effectue ensuite sur cette feuille employé en ajout des lignes préexistantes (ou non).
Un bouton est ajouté, il est lié à la macro "InsérerLigne" à développer.
Les validations de données sont actives sur les feuilles crées
Une Mise en Forme Conditionnelle à été ajoutée pour le quadrillage.

Nouveaux codes :

VB:

Const lgn1 = 4 'ligne de départ

'======================================================
'AJOUTER DES COLONNES A LA FEUILLE "Suivi des dossiers"
'======================================================
Sub CréerColonnes()
    
     Dim wSh As Worksheet, derlgn As Long
     Application.ScreenUpdating = False
    
     Set wSh = ShSuivi
     With wSh
     'Effacer les filtres
          If .FilterMode Then .ShowAllData
          .AutoFilterMode = False
    
          derlgn = .Cells(.Rows.Count, 1).End(xlUp).Row
          If derlgn < lgn1 Then Exit Sub
          
     'Insertion d'une colonne en 2ième position
          .Columns(2).Insert
          .Cells(lgn1, 2) = "Résultat"
          
     'Insertion de 3 colonnes en tête
          .Columns(1).Resize(, 3).Insert
          
     'Validation des données
          .Cells(lgn1, 1) = "Ville"
          With .Range(.Cells(lgn1 + 1, 1), .Cells(derlgn, 1)).Validation   'de la 1ère ligne de saisie à la dernière (col A)
               .Delete
               .Add Type:=xlValidateList, Formula1:="=chx_Ville"           'utilisation du nom défini chx_ville
          End With
          
          .Cells(lgn1, 2) = "Type d'achat"
          With .Range(.Cells(lgn1 + 1, 2), .Cells(derlgn, 2)).Validation   'de la 1ère ligne de saisie à la dernière (col B)
               .Delete
               .Add Type:=xlValidateList, Formula1:="=chx_Type"            'utilisation du nom défini chx_type
          End With
          
          .Cells(lgn1, 3) = "# facture"
          
     'Mettre un format (jjj*  jj/mm/aaa) par exemple en colonne 4
          With .Range(.Cells(lgn1 + 1, 4), .Cells(derlgn, 4))
               .NumberFormatLocal = "jjj* jj/mm/aaaa"
               .HorizontalAlignment = xlRight
               .IndentLevel = 1
          End With
              
          'format conditionnel pour bordures
          .Cells(lgn1, 1).Activate
          ColEmployé = WorksheetFunction.Match("Employé", .Rows(lgn1), 0)
          With .Range(.Cells(lgn1, 1), .Cells(.Rows.Count, ColEmployé)).FormatConditions
               .Delete
               With .Add(xlExpression, Formula1:="=" & wSh.Cells(lgn1, ColEmployé).Address(False, True, xlA1) & "<>""""")
                    .Borders.LineStyle = xlContinuous
                    .Borders.Color = 12874308
               End With
          End With
          
     'Activer les filtres
          .Cells(lgn1, 1).AutoFilter
          
     End With
     Application.ScreenUpdating = True
    
End Sub

VB:

'=====================================================================================
'Transfert des données "Employé" après éventuelle création de la feuille correspondant
'=====================================================================================
Sub TransfertDonnéesEmployés()
     Dim wShSce As Worksheet, wSh As Worksheet
     Dim Dico As Object, DicLgn As Object
     Dim Shp As Shape
    
     Application.ScreenUpdating = False
    
     Set Dico = CreateObject("Scripting.Dictionary")
     Set DicLgn = CreateObject("Scripting.Dictionary")
    
     'Lecture de la feuille source (ici "Suivi des dossiers")
     Set wShSce = ShSuivi
     With wShSce
          If .FilterMode Then .ShowAllData
          ColEmployé = WorksheetFunction.Match("Employé", .Rows(lgn1), 0)
          tbdonnées = .Cells(lgn1, 1).CurrentRegion
     End With
     NbLgnSce = UBound(tbdonnées, 1)
     nbcol = UBound(tbdonnées, 2)
    
     ReDim TitresCol(1 To 1, 1 To nbcol)     'titre des colonnes à copier
     For j = 1 To nbcol
          TitresCol(1, j) = tbdonnées(1, j)
     Next
    
     'Collecte dans un dictionnaire des employés et des lignes qui leur correspondent
     DicLgn("1") = 1
     For i = 2 To UBound(tbdonnées)
          If tbdonnées(i, ColEmployé) <> "" Then Dico(tbdonnées(i, ColEmployé)) = Dico(tbdonnées(i, ColEmployé)) & "¤" & i
          DicLgn(CStr(i)) = i
     Next i

     clefs = Dico.Keys: valeurs = Dico.Items
     n = -1
     Message = "Nouvelle(s) feuille(s) crée(s) :"
     Texte = Message
     For Each clef In clefs
          n = n + 1
          If FeuilleExiste(CStr(clef)) Then  '=>ne pas tenter de créer une feuile qui existe déjà
               Set wSh = ThisWorkbook.Worksheets(CStr(clef))
          Else
               Texte = Texte & Chr(10) & Chr(9) & "Employé " & clef
               Set wSh = ThisWorkbook.Worksheets.Add(before:=shDonnées)    'Création de la feuille Employé
               ActiveWindow.DisplayGridlines = False
               With wSh
                    .Name = clef                                           'Attribution du nom
                    .Cells(lgn1, 1).Resize(1, nbcol).Value = TitresCol     'Coller les titres de colonne
               End With
          End If
          
         With wSh
               LgnDéb = .Cells(.Rows.Count, ColEmployé).End(xlUp).Row     'Première ligne libre dans la colonne Employé
               LgnàCopier = Split(valeurs(n), "¤")                              'Identifier les lignes à copier (l'élément 0 est vide et ne sera pas lu)
               nblgn = UBound(LgnàCopier)
               ReDim tbres(1 To nblgn, 1 To nbcol)                              'Créer un tableau avec les valeurs à copier
               For i = 1 To nblgn
                    For j = 1 To nbcol
                         tbres(i, j) = tbdonnées(LgnàCopier(i), j)
                    Next j
                    DicLgn.Remove LgnàCopier(i)                                 'Retire cette ligne du dictionnaire des lignes à conserver
               Next i
               .Cells(LgnDéb + 1, 1).Resize(nblgn, nbcol).Value = tbres         'Coller les valeur dans la feuille Employé
              
               'Validation des données
               derlgn = .Cells(.Rows.Count, ColEmployé).End(xlUp).Row
               With .Range(.Cells(lgn1 + 1, 1), .Cells(derlgn, 1)).Validation   'de la 1ère ligne de saisie à la dernière (col A)
                    .Delete
                    .Add Type:=xlValidateList, Formula1:="=chx_Ville"           'utilisation du nom défini chx_ville
               End With
              
               With .Range(.Cells(lgn1 + 1, 2), .Cells(derlgn, 2)).Validation   'de la 1ère ligne de saisie à la dernière (col B)
                    .Delete
                    .Add Type:=xlValidateList, Formula1:="=chx_Type"            'utilisation du nom défini chx_type
               End With
              
               'Mettre un format (jjj*  jj/mm/aaa) par exemple en colonne 4
               With .Range(.Cells(lgn1 + 1, 4), .Cells(derlgn, 4))
                    .NumberFormatLocal = "jjj* jj/mm/aaaa"
                    .HorizontalAlignment = xlRight
                    .IndentLevel = 1
               End With
               'format conditionnel pour bordures
               .Cells(lgn1, 1).Activate
               With .Range(.Cells(lgn1, 1), .Cells(.Rows.Count, ColEmployé)).FormatConditions
                    .Delete
                    With .Add(xlExpression, Formula1:="=" & wSh.Cells(lgn1, ColEmployé).Address(False, True, xlA1) & "<>""""")
                         .Borders.LineStyle = xlContinuous
                         .Borders.Color = 12874308
                    End With
               End With
               wShSce.Rows(lgn1).Copy
               .Rows(lgn1).PasteSpecial Paste:=xlPasteColumnWidths
               If Not .AutoFilterMode Then .Cells(lgn1, 1).AutoFilter
          
               'Ajouter le bouton
               Set Shp = .Shapes.AddShape(msoShapeRoundedRectangle, .[J1].Left, .[J1].Top, 180, 30)
               Shp.OnAction = "InsérerLigne"
               With Shp.TextFrame2
                    .VerticalAnchor = msoAnchorMiddle
                    With .TextRange
                         .Font.Size = 16
                         .Font.Bold = True
                         .Text = "Ajouter ligne"
                         With .ParagraphFormat
                              .Alignment = msoTextEffectAlignmentCentered
                         End With
                    End With
               End With
          
          End With
     Next
    
     lgnAconserver = DicLgn.Count    'nbre de lignes à conserver restantes
    
     'Constitution d'une tableau des données à conserver
     ReDim tbres(1 To lgnAconserver, 1 To nbcol)
     clefs = DicLgn.Keys: valeurs = DicLgn.Items
     For i = 1 To lgnAconserver
          l = valeurs(i - 1)
          For j = 1 To nbcol
               tbres(i, j) = tbdonnées(l, j)
          Next
     Next
    
     'Effacer les anciennes données et coller les données à conserver
     With wShSce
          .Cells(lgn1, 1).CurrentRegion.ClearContents
          .Cells(lgn1, 1).Resize(lgnAconserver, nbcol) = tbres
          If Not .AutoFilterMode Then .Cells(lgn1, 1).AutoFilter
          .Activate
     End With
     Application.ScreenUpdating = True
     If Texte <> Message Then MsgBox Title:="Création de feuilles employé", Prompt:=Texte

End Sub

A bientôt

Roseline · 4 Juin 2024

AtTheOne à dit:

Re, il se fait tard !

En pièce jointe le classeur modifier.

La macro de création et transfert de lignes vérifie l'existence de la feuille "Employé" et la crée éventuellement.
Le transfert les données s'effectue ensuite sur cette feuille employé en ajout des lignes préexistantes (ou non).
Un bouton est ajouté, il est lié à la macro "InsérerLigne" à développer.
Les validations de données sont actives sur les feuilles crées
Une Mise en Forme Conditionnelle à été ajoutée pour le quadrillage.

Nouveaux codes :

VB:

Const lgn1 = 4 'ligne de départ

'======================================================
'AJOUTER DES COLONNES A LA FEUILLE "Suivi des dossiers"
'======================================================
Sub CréerColonnes()
   
     Dim wSh As Worksheet, derlgn As Long
     Application.ScreenUpdating = False
   
     Set wSh = ShSuivi
     With wSh
     'Effacer les filtres
          If .FilterMode Then .ShowAllData
          .AutoFilterMode = False
   
          derlgn = .Cells(.Rows.Count, 1).End(xlUp).Row
          If derlgn < lgn1 Then Exit Sub
         
     'Insertion d'une colonne en 2ième position
          .Columns(2).Insert
          .Cells(lgn1, 2) = "Résultat"
         
     'Insertion de 3 colonnes en tête
          .Columns(1).Resize(, 3).Insert
         
     'Validation des données
          .Cells(lgn1, 1) = "Ville"
          With .Range(.Cells(lgn1 + 1, 1), .Cells(derlgn, 1)).Validation   'de la 1ère ligne de saisie à la dernière (col A)
               .Delete
               .Add Type:=xlValidateList, Formula1:="=chx_Ville"           'utilisation du nom défini chx_ville
          End With
         
          .Cells(lgn1, 2) = "Type d'achat"
          With .Range(.Cells(lgn1 + 1, 2), .Cells(derlgn, 2)).Validation   'de la 1ère ligne de saisie à la dernière (col B)
               .Delete
               .Add Type:=xlValidateList, Formula1:="=chx_Type"            'utilisation du nom défini chx_type
          End With
         
          .Cells(lgn1, 3) = "# facture"
         
     'Mettre un format (jjj*  jj/mm/aaa) par exemple en colonne 4
          With .Range(.Cells(lgn1 + 1, 4), .Cells(derlgn, 4))
               .NumberFormatLocal = "jjj* jj/mm/aaaa"
               .HorizontalAlignment = xlRight
               .IndentLevel = 1
          End With
             
          'format conditionnel pour bordures
          .Cells(lgn1, 1).Activate
          ColEmployé = WorksheetFunction.Match("Employé", .Rows(lgn1), 0)
          With .Range(.Cells(lgn1, 1), .Cells(.Rows.Count, ColEmployé)).FormatConditions
               .Delete
               With .Add(xlExpression, Formula1:="=" & wSh.Cells(lgn1, ColEmployé).Address(False, True, xlA1) & "<>""""")
                    .Borders.LineStyle = xlContinuous
                    .Borders.Color = 12874308
               End With
          End With
         
     'Activer les filtres
          .Cells(lgn1, 1).AutoFilter
         
     End With
     Application.ScreenUpdating = True
   
End Sub

VB:

'=====================================================================================
'Transfert des données "Employé" après éventuelle création de la feuille correspondant
'=====================================================================================
Sub TransfertDonnéesEmployés()
     Dim wShSce As Worksheet, wSh As Worksheet
     Dim Dico As Object, DicLgn As Object
     Dim Shp As Shape
   
     Application.ScreenUpdating = False
   
     Set Dico = CreateObject("Scripting.Dictionary")
     Set DicLgn = CreateObject("Scripting.Dictionary")
   
     'Lecture de la feuille source (ici "Suivi des dossiers")
     Set wShSce = ShSuivi
     With wShSce
          If .FilterMode Then .ShowAllData
          ColEmployé = WorksheetFunction.Match("Employé", .Rows(lgn1), 0)
          tbdonnées = .Cells(lgn1, 1).CurrentRegion
     End With
     NbLgnSce = UBound(tbdonnées, 1)
     nbcol = UBound(tbdonnées, 2)
   
     ReDim TitresCol(1 To 1, 1 To nbcol)     'titre des colonnes à copier
     For j = 1 To nbcol
          TitresCol(1, j) = tbdonnées(1, j)
     Next
   
     'Collecte dans un dictionnaire des employés et des lignes qui leur correspondent
     DicLgn("1") = 1
     For i = 2 To UBound(tbdonnées)
          If tbdonnées(i, ColEmployé) <> "" Then Dico(tbdonnées(i, ColEmployé)) = Dico(tbdonnées(i, ColEmployé)) & "¤" & i
          DicLgn(CStr(i)) = i
     Next i

     clefs = Dico.Keys: valeurs = Dico.Items
     n = -1
     Message = "Nouvelle(s) feuille(s) crée(s) :"
     Texte = Message
     For Each clef In clefs
          n = n + 1
          If FeuilleExiste(CStr(clef)) Then  '=>ne pas tenter de créer une feuile qui existe déjà
               Set wSh = ThisWorkbook.Worksheets(CStr(clef))
          Else
               Texte = Texte & Chr(10) & Chr(9) & "Employé " & clef
               Set wSh = ThisWorkbook.Worksheets.Add(before:=shDonnées)    'Création de la feuille Employé
               ActiveWindow.DisplayGridlines = False
               With wSh
                    .Name = clef                                           'Attribution du nom
                    .Cells(lgn1, 1).Resize(1, nbcol).Value = TitresCol     'Coller les titres de colonne
               End With
          End If
         
         With wSh
               LgnDéb = .Cells(.Rows.Count, ColEmployé).End(xlUp).Row     'Première ligne libre dans la colonne Employé
               LgnàCopier = Split(valeurs(n), "¤")                              'Identifier les lignes à copier (l'élément 0 est vide et ne sera pas lu)
               nblgn = UBound(LgnàCopier)
               ReDim tbres(1 To nblgn, 1 To nbcol)                              'Créer un tableau avec les valeurs à copier
               For i = 1 To nblgn
                    For j = 1 To nbcol
                         tbres(i, j) = tbdonnées(LgnàCopier(i), j)
                    Next j
                    DicLgn.Remove LgnàCopier(i)                                 'Retire cette ligne du dictionnaire des lignes à conserver
               Next i
               .Cells(LgnDéb + 1, 1).Resize(nblgn, nbcol).Value = tbres         'Coller les valeur dans la feuille Employé
             
               'Validation des données
               derlgn = .Cells(.Rows.Count, ColEmployé).End(xlUp).Row
               With .Range(.Cells(lgn1 + 1, 1), .Cells(derlgn, 1)).Validation   'de la 1ère ligne de saisie à la dernière (col A)
                    .Delete
                    .Add Type:=xlValidateList, Formula1:="=chx_Ville"           'utilisation du nom défini chx_ville
               End With
             
               With .Range(.Cells(lgn1 + 1, 2), .Cells(derlgn, 2)).Validation   'de la 1ère ligne de saisie à la dernière (col B)
                    .Delete
                    .Add Type:=xlValidateList, Formula1:="=chx_Type"            'utilisation du nom défini chx_type
               End With
             
               'Mettre un format (jjj*  jj/mm/aaa) par exemple en colonne 4
               With .Range(.Cells(lgn1 + 1, 4), .Cells(derlgn, 4))
                    .NumberFormatLocal = "jjj* jj/mm/aaaa"
                    .HorizontalAlignment = xlRight
                    .IndentLevel = 1
               End With
               'format conditionnel pour bordures
               .Cells(lgn1, 1).Activate
               With .Range(.Cells(lgn1, 1), .Cells(.Rows.Count, ColEmployé)).FormatConditions
                    .Delete
                    With .Add(xlExpression, Formula1:="=" & wSh.Cells(lgn1, ColEmployé).Address(False, True, xlA1) & "<>""""")
                         .Borders.LineStyle = xlContinuous
                         .Borders.Color = 12874308
                    End With
               End With
               wShSce.Rows(lgn1).Copy
               .Rows(lgn1).PasteSpecial Paste:=xlPasteColumnWidths
               If Not .AutoFilterMode Then .Cells(lgn1, 1).AutoFilter
         
               'Ajouter le bouton
               Set Shp = .Shapes.AddShape(msoShapeRoundedRectangle, .[J1].Left, .[J1].Top, 180, 30)
               Shp.OnAction = "InsérerLigne"
               With Shp.TextFrame2
                    .VerticalAnchor = msoAnchorMiddle
                    With .TextRange
                         .Font.Size = 16
                         .Font.Bold = True
                         .Text = "Ajouter ligne"
                         With .ParagraphFormat
                              .Alignment = msoTextEffectAlignmentCentered
                         End With
                    End With
               End With
         
          End With
     Next
   
     lgnAconserver = DicLgn.Count    'nbre de lignes à conserver restantes
   
     'Constitution d'une tableau des données à conserver
     ReDim tbres(1 To lgnAconserver, 1 To nbcol)
     clefs = DicLgn.Keys: valeurs = DicLgn.Items
     For i = 1 To lgnAconserver
          l = valeurs(i - 1)
          For j = 1 To nbcol
               tbres(i, j) = tbdonnées(l, j)
          Next
     Next
   
     'Effacer les anciennes données et coller les données à conserver
     With wShSce
          .Cells(lgn1, 1).CurrentRegion.ClearContents
          .Cells(lgn1, 1).Resize(lgnAconserver, nbcol) = tbres
          If Not .AutoFilterMode Then .Cells(lgn1, 1).AutoFilter
          .Activate
     End With
     Application.ScreenUpdating = True
     If Texte <> Message Then MsgBox Title:="Création de feuilles employé", Prompt:=Texte

End Sub

A bientôt

wowo quel boulot tu as fait c'est tout simplement magique. J'ai adapté tout cela et sérieux c'est incroyable. Il y a seulement un point ou ca bloque, quand l'onglet de l'employé est créé et que je tente un nouveau transfert la vba arrête à cet endroit :
'format conditionnel pour bordures
.Cells(lgn1, 1).Activate
As-tu une idée

AtTheOne · 4 Juin 2024

Bonjour à toutes et à tous, bonjour @Roseline

Roseline à dit:
As-tu une idée

Oui, c'est parce-que la feuille n'est pas la feuille active, dans ce cas on ne peut pas activer une de ses cellules.
J'ai remplacé .Cells(lgn1, 1).Activate par Application.Goto.Cells(lgn1, 1)
A bientôt

Roseline · 6 Juin 2024

AtTheOne à dit:
Bonjour à toutes et à tous, bonjour @Roseline

Oui, c'est parce-que la feuille n'est pas la feuille active, dans ce cas on ne peut pas activer une de ses cellules.
J'ai remplacé .Cells(lgn1, 1).Activate par Application.Goto.Cells(lgn1, 1)
A bientôt

Encore wow, c'est fantastique, j'ai tout adapté cela à mon fichier et sérieux c'est de la bombe. Une dernière chose par contre, c'est que le "Set Shp = .Shapes.AddShape(msoShape" se refait à chaque transfert de données, j'aimerais qu'il se crée une fois mais pas à tous les transferts de données et là j'ai encore une fois besoin de ton aide.
Merci

AtTheOne · 6 Juin 2024

Bonjour @Roseline

Roseline à dit:
le "Set Shp = .Shapes.AddShape(msoShape" se refait à chaque transfert de données,

Je vous ça ce soir

Microsoft 365 Ajout d'onglet par VBA et entête de colonnes

XLDnaute Occasionnel

Pièces jointes

XLDnaute Accro

Pièces jointes

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Accro

Pièces jointes

XLDnaute Occasionnel

XLDnaute Accro

Pièces jointes

XLDnaute Occasionnel

XLDnaute Accro

Discussions similaires

Partager cette page

Statistiques des forums