XL 2019 MACRO POUR REGROUPER DES FICHIERS

miha · 3 Août 2019

Bonjour,
Je souhaite parcourir un répertoire (dossier et sous dossier), cherchant dans les dossiers dont le nom figure dans la feuille "feuil1" (liste de A1 à A30) les fichiers dont le nom commence par "FICHIER" EXTENSION xlsx ; Dans chaque fichier je m’intéresse aux feuilles "DATA" plage de données (ligne9 jusuq'à la dernière ligne) que je souhaite regrouper l'une après l'autre dans la 2eme feuille de mon ficher à macro.

Merci normalement pour votre aide précieuse.

Hasco · 3 Août 2019

Bonjour,

Voir dans la section 'discussions similaires' tout en bas de cette page, il y a plus de ressources qu'il n'en faut pour commencer quelque chose et revenir éventuellement avec une difficulté particulière.

Bonne nuit

mapomme · 3 Août 2019

Bonjour @miha , @Roblochon ,

Voir un essai dans le fichier .xlsm joint. Pour l'exemple fourni :

Il faut dézipper, en conservant l'arborescence, le fichier compressé toto.zip à la racine du disque dur C (les données de Feui1 du fichier .xlsm font référence à la racine C:\)
on parcourt toutes les arborescences des dossiers indiqués en colonne A de Feuil1
il faut cliquer sur le bouton Hop! du fichier .xlsm
le code se trouve dans le module Module1
il y a au début des constantes à adapter à votre cas réel

Le code:

VB:

Const FeuilleRep = "Feuil1"   'nom de la feuille des répertoires à parcourir (colonne A)
Const Debut = "Source"        'le début des noms des fichiers à concaténer
Const Extension = "xlsx"      'l'extension des fichiers à concaténer
Const FeuilSource = "Data"    'nom de la feuille où sont des données à concaténer
Const LigneDebut = 9          'ligne de début de la zone à concaténer
Const FeuilCible = "Concat"   'Nom de la feuille destination des données (dans ce classeur)
Dim dicoFichier               'dictionnaire des fichiers à concaténer

Sub Concatener()
Dim fic
  Application.ScreenUpdating = False
  CreerDicoDesFichiers
  With ThisWorkbook.Sheets(FeuilCible)
    .Cells.Clear
    For Each fic In dicoFichier
      ConcatUnFichier (fic)
    Next fic
    .Rows(1).Delete
    Application.Goto .Range("a1"), True
  End With
  MsgBox "Concaténation terminée", vbInformation
End Sub

Sub ConcatUnFichier(xfic)
Dim der&, xrg As Range, num&
  Workbooks.Open xfic
  With ActiveWorkbook.Sheets(FeuilSource)
    der = .Cells(.Rows.Count, "a").End(xlUp).Row
    If der >= LigneDebut Then
      Set xrg = .Range("9:" & der)
      With ThisWorkbook.Sheets(FeuilCible)
        num = .Cells(.Rows.Count, "a").End(xlUp).Row + 1
        xrg.Copy .Rows(num)
      End With
    End If
    .Parent.Close SaveChanges:=False
  End With
End Sub

Sub CreerDicoDesFichiers()
Dim xcell
  Set dicoFichier = CreateObject("scripting.dictionary")
  With Sheets(FeuilleRep)
    For Each xcell In .Range("a1:a" & .Cells(Rows.Count, "a").End(xlUp).Row)
      ListeFichiers xcell, Debut & "*." & Extension
    Next xcell
  End With
End Sub

Sub ListeFichiers(xrep, modele)
'procédure récursive
Dim fso As New FileSystemObject, fic, rep
  Set fso = CreateObject("scripting.FileSystemObject")
  For Each fic In fso.GetFolder(xrep).Files
    If LCase(fic.Name) Like LCase(modele) Then dicoFichier.Add fic, ""
  Next fic
  For Each rep In fso.GetFolder(xrep).SubFolders
    ListeFichiers rep, Debut & "*." & Extension
  Next rep
End Sub

edit : 13h18 modification code (remplacé une expression constante par variable)

miha · 4 Août 2019

mapomme à dit:

Bonjour @miha , @Roblochon ,

Voir un essai dans le fichier .xlsm joint. Pour l'exemple fourni :

Il faut dézipper, en conservant l'arborescence, le fichier compressé toto.zip à la racine du disque dur C (les données de Feui1 du fichier .xlsm font référence à la racine C:\)
on parcourt toutes les arborescences des dossiers indiqués en colonne A de Feuil1
il faut cliquer sur le bouton Hop! du fichier .xlsm
le code se trouve dans le module Module1
il y a au début des constantes à adapter à votre cas réel

Le code:

VB:

Const FeuilleRep = "Feuil1"   'nom de la feuille des répertoires à parcourir (colonne A)
Const Debut = "Source"        'le début des noms des fichiers à concaténer
Const Extension = "xlsx"      'l'extension des fichiers à concaténer
Const FeuilSource = "Data"    'nom de la feuille où sont des données à concaténer
Const LigneDebut = 9          'ligne de début de la zone à concaténer
Const FeuilCible = "Concat"   'Nom de la feuille destination des données (dans ce classeur)
Dim dicoFichier               'dictionnaire des fichiers à concaténer

Sub Concatener()
Dim fic
  Application.ScreenUpdating = False
  CreerDicoDesFichiers
  With ThisWorkbook.Sheets(FeuilCible)
    .Cells.Clear
    For Each fic In dicoFichier
      ConcatUnFichier (fic)
    Next fic
    .Rows(1).Delete
    Application.Goto .Range("a1"), True
  End With
  MsgBox "Concaténation terminée", vbInformation
End Sub

Sub ConcatUnFichier(xfic)
Dim der&, xrg As Range, num&
  Workbooks.Open xfic
  With ActiveWorkbook.Sheets(FeuilSource)
    der = .Cells(.Rows.Count, "a").End(xlUp).Row
    If der >= LigneDebut Then
      Set xrg = .Range("9:" & der)
      With ThisWorkbook.Sheets(FeuilCible)
        num = .Cells(.Rows.Count, "a").End(xlUp).Row + 1
        xrg.Copy .Rows(num)
      End With
    End If
    .Parent.Close SaveChanges:=False
  End With
End Sub

Sub CreerDicoDesFichiers()
Dim xcell
  Set dicoFichier = CreateObject("scripting.dictionary")
  With Sheets(FeuilleRep)
    For Each xcell In .Range("a1:a" & .Cells(Rows.Count, "a").End(xlUp).Row)
      ListeFichiers xcell, Debut & "*." & Extension
    Next xcell
  End With
End Sub

Sub ListeFichiers(xrep, modele)
'procédure récursive
Dim fso As New FileSystemObject, fic, rep
  Set fso = CreateObject("scripting.FileSystemObject")
  For Each fic In fso.GetFolder(xrep).Files
    If LCase(fic.Name) Like LCase(modele) Then dicoFichier.Add fic, ""
  Next fic
  For Each rep In fso.GetFolder(xrep).SubFolders
    ListeFichiers rep, Debut & "*." & Extension
  Next rep
End Sub

edit : 13h18 modification code (remplacé une expression constante par variable)

Merci bien pour ta contribution, toutefois la procédure Sub ListeFichiers(xrep, modele) se bloque sur l'instruction
"For Each fic In fso.GetFolder(xrep).Files" . J'ai activé le MS script runtime, mais toujours rien !

miha · 4 Août 2019

miha à dit:
Merci bien pour ta contribution, toutefois la procédure Sub ListeFichiers(xrep, modele) se bloque sur l'instruction
"For Each fic In fso.GetFolder(xrep).Files" . J'ai activé le MS script runtime, mais toujours rien !

En fait je crois bien que le problème est dans la source de mes dossiers; ils sont pas sur mon disque local c'est sur un serveur

mapomme · 4 Août 2019

Re @miha ,

miha à dit:
En fait je crois bien que le problème est dans la source de mes dossiers; ils sont pas sur mon disque local c'est sur un serveur

J'ai fait le test sur le serveur de ma boîte. Dans le gestionnaire de fichiers Windows, le serveur est relié au volume N.
En indiquant comme répertoire N:\toto et N:\totobis, la macro se déroule normalement (la durée est augmentée car les fichiers à ouvrir sont sur le serveur).

Je ne sais pas comment tu accédes à ton serveur. Mais si tu as l'adresse de ton serveur, tu peux toujours le relier à un volume de ton choix via la commande "Connecter un lecteur réseau" du gestionnaire de fichiers Windows [à condition de disposer des droits pour le faire]. Il semblerait même qu'on puisse le faire via macro (connecter le serveur avec la première lettre de volume disponible puis le déconnecter à la fin de la macro).

Dranreb · 4 Août 2019

Bonjour.
Un peu remanié comme ça, qu'est-ce que ça donne avec des chemins réseaux ?

VB:

Option Explicit
Const FeuilleRep = "Feuil1"   ' Nom de la feuille des répertoires à parcourir (colonne A)
Const Debut = "Source"        ' Début des noms des fichiers à concaténer
Const Extension = "xlsx"      ' Extension des fichiers à concaténer
Const FeuilSource = "Data"    ' Nom de la feuille où sont des données à concaténer
Const LigneDébut = 9          ' Ligne de début de la zone à concaténer
Const FeuilCible = "Concat"   ' Nom de la feuille destination des données (dans ce classeur)
Private ClnFichier As New Collection ' Collection des fichiers à concatéténer
Sub Concatener()
   Dim Fle As File, L As Long
   Application.ScreenUpdating = False
   CreerCollectionFichiers
   With ThisWorkbook.Sheets(FeuilCible)
      .Cells.Clear
      L = 1
      For Each Fle In ClnFichier
         ConcatUnFichier Fle, L
         Next Fle
      Application.Goto .Range("a1"), True
   End With
   MsgBox "Concaténation terminée", vbInformation
   End Sub
Sub ConcatUnFichier(ByVal Fle As File, ByRef LCbl As Long)
   Dim Wbk As Workbook, Wsh As Worksheet, RngSrc As Range, LFin As Long
   Set Wbk = Workbooks.Open(Fle.Path)
   On Error Resume Next: Set Wsh = Wbk.Worksheets(FeuilSource)
   On Error GoTo 0: If Wsh Is Nothing Then MsgBox "Le classeur :" & vbLf & Wbk.FullName & vbLf & _
      "ne possède pas de feuille """ & FeuilSource & """.", vbExclamation, "ConcatUnFichier": Exit Sub
   LFin = Wsh.Cells(Wsh.Rows.Count, "A").End(xlUp).Row
   If LFin >= LigneDébut Then
      Set RngSrc = Wsh.Range(Wsh.Rows(LigneDébut), Wsh.Rows(LFin))
      RngSrc.Copy ThisWorkbook.Worksheets(FeuilCible).Rows(LCbl)
      LCbl = LCbl + RngSrc.Rows.Count
      End If
   Wbk.Close SaveChanges:=False
   End Sub
Sub CreerCollectionFichiers()
   Dim Cel As Range, Chemin As String, FSO As New FileSystemObject, Fdr As Folder
   With ThisWorkbook.Worksheets(FeuilleRep)
      For Each Cel In .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
         Chemin = Cel.Value
         On Error Resume Next
         Set Fdr = FSO.GetFolder(Chemin)
         If Err Then
            MsgBox "Erreur " & Err & " en tentant d'acéder à :" & vbLf & Chemin _
               & vbLf & Err.Description, vbCritical, "CréerCollectionFichiers"
            End
         Else: ListeFichiers Fdr, Debut & "*." & Extension: End If
      Next Cel
   End With
End Sub
Sub ListeFichiers(ByVal Fdr As Folder, ByVal Modèle As String) '(Récursif)
   Dim SubFdr As Folder, Fle As File
      For Each Fle In Fdr.Files
         If LCase(Fle.Name) Like LCase(Modèle) Then ClnFichier.Add Fle
         Next Fle
      For Each SubFdr In Fdr.SubFolders
         ListeFichiers SubFdr, Modèle
         Next SubFdr
   End Sub

mapomme · 4 Août 2019

Bonjour @Dranreb ,

Arrrrrgh! J'avais fait l'impasse sur les deux vérifications (classeur et feuille) en espérant que ça passerait inaperçu. C'est raté !
Ta version fonctionne en local et pour un lecteur réseau associé à un volume.

Bon dimanche

Dranreb · 4 Août 2019

Bonjour @mapomme.

Remanié encore.
Collection nettoyée pour ne pas risquer d'empiler tout en double, et puis peut être pas nécessaire d'y stocker les objets File eux mêmes)

VB:

Option Explicit
Const FeuilleRep = "Feuil1"   ' Nom de la feuille des répertoires à parcourir (colonne A)
Const Debut = "Source"        ' Début des noms des fichiers à concaténer
Const Extension = "xlsx"      ' Extension des fichiers à concaténer
Const FeuilSource = "Data"    ' Nom de la feuille où sont des données à concaténer
Const LigneDébut = 9          ' Ligne de début de la zone à concaténer
Const FeuilCible = "Concat"   ' Nom de la feuille destination des données (dans ce classeur)
Private ClnRéfFics As Collection ' Collection de noms de fichiers à concatéténer
Sub Concatener()
   Dim RéfFic, L As Long
   Application.ScreenUpdating = False
   CréerClnRéfFics
   With ThisWorkbook.Sheets(FeuilCible)
      .Cells.Clear
      L = 1
      For Each RéfFic In ClnRéfFics
         ConcatUnFichier RéfFic, L
         Next RéfFic
      Application.Goto .Range("A1"), True
   End With
   MsgBox "Concaténation terminée", vbInformation
   Set ClnRéfFics = Nothing
   End Sub
Sub ConcatUnFichier(ByVal RéfFic As String, ByRef LCbl As Long)
   Dim Wbk As Workbook, Wsh As Worksheet, RngSrc As Range, LFin As Long
   Set Wbk = Workbooks.Open(RéfFic)
   On Error Resume Next: Set Wsh = Wbk.Worksheets(FeuilSource)
   On Error GoTo 0: If Wsh Is Nothing Then MsgBox "Le classeur :" & vbLf & Wbk.FullName & vbLf & _
      "ne possède pas de feuille """ & FeuilSource & """.", vbExclamation, "ConcatUnFichier": Exit Sub
   LFin = Wsh.Cells(Wsh.Rows.Count, "A").End(xlUp).Row
   If LFin >= LigneDébut Then
      Set RngSrc = Wsh.Range(Wsh.Rows(LigneDébut), Wsh.Rows(LFin))
      RngSrc.Copy ThisWorkbook.Worksheets(FeuilCible).Rows(LCbl)
      LCbl = LCbl + RngSrc.Rows.Count
      End If
   Wbk.Close SaveChanges:=False
   End Sub
Sub CréerClnRéfFics()
   Dim Cel As Range, Chemin As String, FSO As New FileSystemObject, Fdr As Folder
   Set ClnRéfFics = New Collection
   With ThisWorkbook.Worksheets(FeuilleRep)
      For Each Cel In .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
         Chemin = Cel.Value
         On Error Resume Next
         Set Fdr = FSO.GetFolder(Chemin)
         If Err Then
            MsgBox "Erreur " & Err & " en tentant d'acéder à :" & vbLf & Chemin _
               & vbLf & Err.Description, vbCritical, "CréerClnRéfFics"
            End
         Else: ListeRéfFics Fdr, LCase(Debut & "*." & Extension): End If
      Next Cel
   End With
End Sub
Sub ListeRéfFics(ByVal Fdr As Folder, ByVal Modèle As String) '(Récursif)
   Dim SubFdr As Folder, Fle As File
   For Each Fle In Fdr.Files
      If LCase(Fle.Name) Like Modèle Then ClnRéfFics.Add Fle.Path
      Next Fle
   For Each SubFdr In Fdr.SubFolders
      ListeRéfFics SubFdr, Modèle
      Next SubFdr
   End Sub

À tester.

mapomme · 4 Août 2019

Dranreb à dit:
pas nécessaire d'y stocker les objets File eux mêmes

Certes

miha · 4 Août 2019

Dranreb à dit:

Bonjour.
Un peu remanié comme ça, qu'est-ce que ça donne avec des chemins réseaux ?

VB:

Option Explicit
Const FeuilleRep = "Feuil1"   ' Nom de la feuille des répertoires à parcourir (colonne A)
Const Debut = "Source"        ' Début des noms des fichiers à concaténer
Const Extension = "xlsx"      ' Extension des fichiers à concaténer
Const FeuilSource = "Data"    ' Nom de la feuille où sont des données à concaténer
Const LigneDébut = 9          ' Ligne de début de la zone à concaténer
Const FeuilCible = "Concat"   ' Nom de la feuille destination des données (dans ce classeur)
Private ClnFichier As New Collection ' Collection des fichiers à concatéténer
Sub Concatener()
   Dim Fle As File, L As Long
   Application.ScreenUpdating = False
   CreerCollectionFichiers
   With ThisWorkbook.Sheets(FeuilCible)
      .Cells.Clear
      L = 1
      For Each Fle In ClnFichier
         ConcatUnFichier Fle, L
         Next Fle
      Application.Goto .Range("a1"), True
   End With
   MsgBox "Concaténation terminée", vbInformation
   End Sub
Sub ConcatUnFichier(ByVal Fle As File, ByRef LCbl As Long)
   Dim Wbk As Workbook, Wsh As Worksheet, RngSrc As Range, LFin As Long
   Set Wbk = Workbooks.Open(Fle.Path)
   On Error Resume Next: Set Wsh = Wbk.Worksheets(FeuilSource)
   On Error GoTo 0: If Wsh Is Nothing Then MsgBox "Le classeur :" & vbLf & Wbk.FullName & vbLf & _
      "ne possède pas de feuille """ & FeuilSource & """.", vbExclamation, "ConcatUnFichier": Exit Sub
   LFin = Wsh.Cells(Wsh.Rows.Count, "A").End(xlUp).Row
   If LFin >= LigneDébut Then
      Set RngSrc = Wsh.Range(Wsh.Rows(LigneDébut), Wsh.Rows(LFin))
      RngSrc.Copy ThisWorkbook.Worksheets(FeuilCible).Rows(LCbl)
      LCbl = LCbl + RngSrc.Rows.Count
      End If
   Wbk.Close SaveChanges:=False
   End Sub
Sub CreerCollectionFichiers()
   Dim Cel As Range, Chemin As String, FSO As New FileSystemObject, Fdr As Folder
   With ThisWorkbook.Worksheets(FeuilleRep)
      For Each Cel In .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
         Chemin = Cel.Value
         On Error Resume Next
         Set Fdr = FSO.GetFolder(Chemin)
         If Err Then
            MsgBox "Erreur " & Err & " en tentant d'acéder à :" & vbLf & Chemin _
               & vbLf & Err.Description, vbCritical, "CréerCollectionFichiers"
            End
         Else: ListeFichiers Fdr, Debut & "*." & Extension: End If
      Next Cel
   End With
End Sub
Sub ListeFichiers(ByVal Fdr As Folder, ByVal Modèle As String) '(Récursif)
   Dim SubFdr As Folder, Fle As File
      For Each Fle In Fdr.Files
         If LCase(Fle.Name) Like LCase(Modèle) Then ClnFichier.Add Fle
         Next Fle
      For Each SubFdr In Fdr.SubFolders
         ListeFichiers SubFdr, Modèle
         Next SubFdr
   End Sub

Merci bien ça marche pour moi, j'ai connecté mes données à un lecteur et j'ai lancé. J'ai désactivé les boites de dialogue et je me suis rendue compte ue je peux accélerer le traitement si je specifie les nom des fichies.xlsx dans la colonne B du "feuil1".

miha · 4 Août 2019

Dranreb à dit:

Bonjour @mapomme.

Remanié encore.
Collection nettoyée pour ne pas risquer d'empiler tout en double, et puis peut être pas nécessaire d'y stocker les objets File eux mêmes)

VB:

Option Explicit
Const FeuilleRep = "Feuil1"   ' Nom de la feuille des répertoires à parcourir (colonne A)
Const Debut = "Source"        ' Début des noms des fichiers à concaténer
Const Extension = "xlsx"      ' Extension des fichiers à concaténer
Const FeuilSource = "Data"    ' Nom de la feuille où sont des données à concaténer
Const LigneDébut = 9          ' Ligne de début de la zone à concaténer
Const FeuilCible = "Concat"   ' Nom de la feuille destination des données (dans ce classeur)
Private ClnRéfFics As Collection ' Collection de noms de fichiers à concatéténer
Sub Concatener()
   Dim RéfFic, L As Long
   Application.ScreenUpdating = False
   CréerClnRéfFics
   With ThisWorkbook.Sheets(FeuilCible)
      .Cells.Clear
      L = 1
      For Each RéfFic In ClnRéfFics
         ConcatUnFichier RéfFic, L
         Next RéfFic
      Application.Goto .Range("A1"), True
   End With
   MsgBox "Concaténation terminée", vbInformation
   Set ClnRéfFics = Nothing
   End Sub
Sub ConcatUnFichier(ByVal RéfFic As String, ByRef LCbl As Long)
   Dim Wbk As Workbook, Wsh As Worksheet, RngSrc As Range, LFin As Long
   Set Wbk = Workbooks.Open(RéfFic)
   On Error Resume Next: Set Wsh = Wbk.Worksheets(FeuilSource)
   On Error GoTo 0: If Wsh Is Nothing Then MsgBox "Le classeur :" & vbLf & Wbk.FullName & vbLf & _
      "ne possède pas de feuille """ & FeuilSource & """.", vbExclamation, "ConcatUnFichier": Exit Sub
   LFin = Wsh.Cells(Wsh.Rows.Count, "A").End(xlUp).Row
   If LFin >= LigneDébut Then
      Set RngSrc = Wsh.Range(Wsh.Rows(LigneDébut), Wsh.Rows(LFin))
      RngSrc.Copy ThisWorkbook.Worksheets(FeuilCible).Rows(LCbl)
      LCbl = LCbl + RngSrc.Rows.Count
      End If
   Wbk.Close SaveChanges:=False
   End Sub
Sub CréerClnRéfFics()
   Dim Cel As Range, Chemin As String, FSO As New FileSystemObject, Fdr As Folder
   Set ClnRéfFics = New Collection
   With ThisWorkbook.Worksheets(FeuilleRep)
      For Each Cel In .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
         Chemin = Cel.Value
         On Error Resume Next
         Set Fdr = FSO.GetFolder(Chemin)
         If Err Then
            MsgBox "Erreur " & Err & " en tentant d'acéder à :" & vbLf & Chemin _
               & vbLf & Err.Description, vbCritical, "CréerClnRéfFics"
            End
         Else: ListeRéfFics Fdr, LCase(Debut & "*." & Extension): End If
      Next Cel
   End With
End Sub
Sub ListeRéfFics(ByVal Fdr As Folder, ByVal Modèle As String) '(Récursif)
   Dim SubFdr As Folder, Fle As File
   For Each Fle In Fdr.Files
      If LCase(Fle.Name) Like Modèle Then ClnRéfFics.Add Fle.Path
      Next Fle
   For Each SubFdr In Fdr.SubFolders
      ListeRéfFics SubFdr, Modèle
      Next SubFdr
   End Sub

À tester.

Est il possible de le remanier de façon à ce que l'on récupère un seul fichier par dossier dont le nom est en feuil1 colonneB ! (path dossier en a1 et nim fichier en b1).
Merci d'avance

Dranreb · 4 Août 2019

Oui, bien sûr, il suffit de remplacer les Const à rendre variables par des Private … As String, ne pas leur mettre de valeur lors de cette déclaration mais les récupérer des cellules voulues au début de la procédure.

mapomme · 4 Août 2019

Re à tous,

miha à dit:
Est il possible de le remanier de façon à ce que l'on récupère un seul fichier par dossier dont le nom est en feuil1 colonneB ! (path dossier en a1 et nim fichier en b1).

Voir un essai dans le fichier .xlsm joint.
Il faut décompresser le .zip à la racine du disque C ou sinon modifier les données en colonne A de Feuil1 du .xlsm joint

XL 2019 MACRO POUR REGROUPER DES FICHIERS

miha

XLDnaute Nouveau

Hasco

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

miha

XLDnaute Nouveau

miha

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

miha

XLDnaute Nouveau

miha

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

Discussions similaires