Regroupement fichiers excel + ajout colonne

Jex9494 Messages postés 2 Date d'inscription   Statut Membre Dernière intervention   -  
Jex9494 Messages postés 2 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

J'ai 521 fichiers excel dans un répertoire avec des données que je souhaiterais regrouper :

Ces fichiers comportent 5 colonnes A à E, le nombre de lignes est variable d'un fichier à l'autre, certaines lignes ont des cellules vides dans une ou plusieurs des 5 colonnes.

Je souhaiterais pouvoir regrouper ces 521 fichiers sur une seule feuille excel dans le même répertoire, non par fusion mais par regroupement de type copié collé, les uns en dessous des autres sans rupture, et en insérant une colonne F afin d'y saisir automatiquement sur chaque ligne le nom du fichier source.

Connaissez-vous un moyen pour automatiser ce regroupement ?

L'algorithme en français (que je ne sais malheureusement pas traduire en VBA) consiste donc à :

1) Ouvrir les 521 fichiers, et copier les données sur un seul et même fichier, les uns à la suite des autres, (Colonnes A à E)
2) Renseigner en colonne F le nom du fichier source de chaque ligne ainsi importée
3) Supprimmer l'ensemble des lignes dont la colonne A ne comporte aucune donnée
4) Supprimmer la colonne E
5) Convertir en nombre les montants des colonnes C et D
6) Supprimmer les lignes dont la colonne A respecte l'une des 3 conditions suivantes

="40100000"
="41100000"
>="60000000"

Je vous remercie par avance pour votre aide.

2 réponses

  1. Jinx
     
    Tu peux tout faire assez facilement en VBA;
    essaie par toi même et si tu bloques sur un bout de la procédure n'hésite pas à venir reposer des questions.

    Voilà qui te sera utile :

    With ThisWorkbook
    DerLgn = .Worksheets(Ws).Range("A65536").End(xlUp).Row
    End With

    Ceci permet de récupérer le nombre de lignes d'un fichier excel, après tu n'as plus qu a faire tes boucles for et tes conditions si la ligne est vide.

    Tu auras besoin de créer des objets excel (Workbook)
    Set Wb = Workbooks.Open("C:/blabla/fichier.xls")
    pour l'ouvrir,
    Wb.Sheets("Feuil1").Range("A1").Value
    pour récupérer une valeur

    Bon courage
    0
  2. Jex9494 Messages postés 2 Date d'inscription   Statut Membre Dernière intervention  
     
    Bonjour Jinx,

    J'ai un bon début de macro pas (un ami m'a aidé) qui permet de traiter les points 1) et 2), c'est à dire de regrouper l'ensemble des fichiers et d'insérer une colonne A pour y saisir le nom de chaque fichier sur chaque ligne regroupée.
    Mais nous avons un problème que nous ne parvenons pas à résoudre car la colonne A reprend bien le nom du fichier sur le nombre total de ligne de chaque fichier, mais chaque fichier n'est pas repris complètement (il manque les 5 dernières lignes à chaque fois :

    Pour être plus précis :

    Mon premier fichier se nomme "ALMANDIN BAL" et il comporte 41 lignes.
    Quand je lance la macro, à la ligne 27, j'ai bien en colonne A la donnée "ALMANDIN BAL", ce qui est correct, mais dans les colonnes B à F, j'ai les premières lignes de mon fichier suivant "ANGE BAL".
    A priori, l'anomalie vient du fait que dans mon fichier "ALMANDIN BAL", la cellule A 27 est vide.

    Saurais-tu identifier le problème précis dans ce code ?

    Dim sRep As String 'Répertoire ou filtre
    Dim sFichier As String
    Dim wb As Workbook, ws As Worksheet, rg As Range
    Dim wbR As Workbook, wsR As Worksheet, rgC As Range
    Dim tablo

    Set wbR = ThisWorkbook 'fichier récapitulatif
    Set wsR = wbR.Sheets("Recap") 'onglet récapitulatif

    Application.ScreenUpdating = False
    sRep = ChoisirRepertoire & "\"
    'Boîte de dialogue pour choisir répertoire
    sFichier = Dir(sRep)
    Do While sFichier <> ""
    If sFichier <> wbR.Name Then
    Set wb = Workbooks.Open(sRep & sFichier) 'ouvrir le fichier
    Set ws = wb.Sheets(1) 'les données se trouvent dans le 1er onglet
    Set rg = ws.Range("A2").CurrentRegion 'sélection des données
    tablo = rg 'mettre les données dans un tablo pour copier ensuite

    wsR.Range("A65000").End(xlUp).Offset(1, 0).Resize(rg.Rows.Count, 1) = wb.Name 'nom du fichier
    wsR.Range("B65000").End(xlUp).Offset(1, 0).Resize(rg.Rows.Count, 4) = tablo 'données
    wb.Close savechanges:=True
    End If
    sFichier = Dir 'trouve le prochain fichier
    Loop
    Application.ScreenUpdating = True
    End Sub
    Function ChoisirRepertoire() As String
    Dim diaFolder As FileDialog
    ' Ouvrir la boîte de dialog
    On Error Resume Next
    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    diaFolder.AllowMultiSelect = False
    diaFolder.Show
    ChoisirRepertoire = diaFolder.SelectedItems(1)
    Set diaFolder = Nothing
    End Function

    Merci par avance pour ton aide !
    Jex
    0