XL 2013 VBA - Amélioration d'une macro consolidation

[Comfortably_Numb]

Bonjour à tous,

J'ai adapté un code VBA permettant la consolidation de plusieurs fichiers construits de la même façon dans un autre fichier, un fichier de synthèse.

Dans les différents fichiers, il y a des formules paramétrées dans certaines colonnes et parfois, dans les fichiers des colonnes sont masquées ce qui fausse la consolidation car il y a décalage des données.

Je souhaiterais améliorer mon code :

- Pour qu'il sélectionne l'entièreté des colonnes de chaque fichier et qu'il affiche celles masquées
- Pour qu'au niveau de la copie réalisée des cellules de chaque fichier, là où à partir de la cellule A3, si la cellule du dessous est vide, il arrête la copie

Voici le code en question :

Option Explicit

'   Déclaration des variables

Dim NomClasseur As String
Dim LigneTotal As Integer
Dim DerLigne As Integer




'   Procédure permettant la consolidation de plusieurs classeurs


Sub Consolider()

'   On désactive le raffraichissement de l'écran
    Application.ScreenUpdating = False

'   Etape 1 : Création des en-têtes

'   On réinitialise le fichier synthèse

    Columns("A:AG").Clear
    Range("A1").Value = "UE"
    Range("B1").Value = "Site"
    Range("C1").Value = "Type"
    Range("D1").Value = "N°"
    Range("E1").Value = "Bailleur / Preneur"
    Range("F1").Value = "Libellé affaire"
    Range("G1").Value = "Client"
    Range("H1").Value = "Emetteur de la demande"
    Range("I1").Value = "Interlocuteur NPM"
    Range("J1").Value = "Date de demande à l'étude"
    Range("K1").Value = "Etape"
    Range("L1").Value = "Commentaire"
    Range("M1").Value = "Date réception devis"
    Range("N1").Value = "Nbre de jours dépassés"
    Range("O1").Value = "Délai Ok/Hors délai"
    Range("P1").Value = "Montant devis retenu"
    Range("Q1").Value = "Origine budget"
    Range("R1").Value = "Imputation"
    Range("S1").Value = "Libellé racine OI"
    Range("T1").Value = "Date accord budget"
    Range("U1").Value = "Groupe acheteur"
    Range("V1").Value = "N° DA"
    Range("W1").Value = "Montant Da saisie auto"
    Range("X1").Value = "Date validation DA"
    Range("Y1").Value = "N° Commande"
    Range("Z1").Value = "Date envoi (MGA) commande"
    Range("AA1").Value = "N° devis fournisseur"
    Range("AB1").Value = "Date livraison"
    Range("AC1").Value = "Date du PV de réception"
    Range("AD1").Value = "Date clôture de la demande"
    Range("AE1").Value = "N° du 101 PGI"
    Range("AF1").Value = "Statut"
    
'   Etape 2 : Parcourir les fichiers du dossier préféfini

    ChDir "C:\Users\jdarras\Desktop\TDB"
'   On cherche le premier classeur dans le dossier
    NomClasseur = Dir("C:\Users\jdarras\Desktop\TDB\*.*")
'   On boucle pour chercher tous les classeurs Excel
    While Len(NomClasseur) > 0
            Application.DisplayAlerts = False   '   Désactive les boîtes de dialogue Excel
            Workbooks.Open NomClasseur  '   Ouverture du classeur
            LigneTotal = ActiveSheet.UsedRange.Rows.Count   '   On récupère le nombre de ligne de données
            Range("A3:AF" & LigneTotal).Copy    '   On copie toutes les données de la feuille active
            Workbooks("Classeur1.xlsm").Activate    '   On revient sur le classeur de synthèse
            DerLigne = ActiveSheet.UsedRange.Rows.Count + 1 '   On recherche la dernière ligne vide de la feuille active
            Range("A" & DerLigne).Select    '   On se positionne sur la dernière ligne vide de la feuille
            ActiveSheet.Paste  '   On colle les données
            Range("AG" & DerLigne & ":AG" & ActiveSheet.UsedRange.Rows.Count) = NomClasseur '   On colle le nom du classeur sur la colonne AG
            Workbooks(NomClasseur).Close    '   Fermeture du classeur ouvert
            NomClasseur = Dir   '   On passe au prochain classeur
                
    Wend
    
'   Etape 3 : Supprimer l'extension des fichiers
    Columns("AG").Replace ".xlsm", ""   '   On retire l'extension des fichiers en colonne AG
    Columns("AG").Replace ".xlsx", ""   '   On retire l'extension des fichiers en colonne AG
    
    MsgBox "La consolidation est terminée."
'   On réactive le raffraichissement de l'écran
    Application.ScreenUpdating = True
    
End Sub

Pensez-vous que c'est réalisable ?

Merci pour votre aide !

 

[Genii]

Essaye de rajouter ça :

With ActiveSheet.UsedRange.Rows.Offset(1)
        .Select
        .EntireColumn.Hidden = False
End With

 

[Comfortably_Numb]

Essaye de rajouter ça :

With ActiveSheet.UsedRange.Rows.Offset(1)
        .Select
       .EntireRow.Hidden = Not .EntireRow.Hidden
    End With

Merci @Genii peux-tu me dire à quel endroit insérer cette partie de code ?

 

[Genii]

Ou bien ça : pour toute la feuille :

With ActiveSheet.Cells

 .EntireColumn.Hidden = False

End With

 

[Genii]

Juste après :

Workbooks.Open NomClasseur  '   Ouverture du classeur

 

[Comfortably_Numb]

Merci @Genii ça résout mon premier problème !

As-tu une idée pour ce point ? :

- Pour qu'au niveau de la copie réalisée des cellules de chaque fichier, là où à partir de la cellule A3, si la cellule du dessous est vide, il arrête la copie

Merci

 

[Genii]

Ca doit être lié à

ActiveSheet.UsedRange.Rows.Count

. Il faudrait que tu mettes un exemple de fichier pour voir.

 

[Comfortably_Numb]

@Genii j'ai contourné le problème en lui faisant supprimer dans la feuille consolidation les lignes si la première cellule est vide en colonne A :

Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Merci pour ton aide !

Dans les fichiers source il y a une mise en forme, enfin des couleurs de remplissage des bordures etc..

Comment faire pour que la macro ne conserve que les valeurs (et les formats date) sans tenir compte des remplissages etc ?

 

[Genii]

A tester :

Range("A3:AF" & LigneTotal).Copy.PasteSpecial Paste:=xlPasteValues    '   On copie toutes les données de la feuille active

Pour ce qui est du format date, je sélectionnerai la ou les colonnes dans le fichier de destination et j'appliquerai le format date souhaité sur toute la colonne.