Regroupement de plusieurs classeur xls en un

Re,

Peux-tu envoyer ledit fichier?

re

voici le fichier :

https://www.excel-pratique.com/~files/doc2/fGlZEbanc.zip

par contre je ne comprend pas la suppression du

                                'If k <> i Then
                                '    .Cells(derLig + 1, 1).Font.ColorIndex = color
                                'End If

la macro (met les bonnes couleurs de la police de la colonne A)

et le rajout du

Sub couleur()
Dim i As Long
Dim coul As Byte
    For i = 12 To Range("I65536").End(xlUp).Row
        If Cells(i - 1, 9) <> Cells(i, 9) Then
            Cells(i, 1).Font.ColorIndex = 1
        ElseIf (Cells(i - 1, 1) = Cells(i, 1) And Cells(i, 1) = Cells(i + 1, 1)) Or _
               (Cells(i - 1, 1) = Cells(i, 1) And Cells(i, 1) <> Cells(i + 1, 1)) Then
            coul = Cells(i, 1).Interior.ColorIndex
            Cells(i, 1).Font.ColorIndex = Cells(i, 1).Interior.ColorIndex
        Else
            Cells(i, 1).Font.ColorIndex = 1
        End If
    Next i
End Sub

cdlt Franck

Bon ça commence (?) vraiment à faire bricolage de macro

Tant pis. As-tu la possibilité d'envoyer les fichiers opto1, opto3 et opto5 et rotatif1 pendant qu'on y est? Ce serait pour des tests.

Parce que je n'arrive pas à comprendre d'où vient l'erreur.

J'ai ajouté une macro "couleur" et supprimé l'autre ligne parce qu'il y avait un problème de couleur de police suite à la résolution de ton problème du 01/09 à 8:06 pm.

Bonjour

je te joint les fichiers par cjoint :

car il sont trop volumineux pour être mis sur le forum.

si vraiment l'action des couleurs est difficile a être gérer, peut-on pas mettre la mise en forme comme cet exemple :

cordialement Franck

Bonjour franck, forum,

Voici le fichier banc en retour : https://www.excel-pratique.com/~files/doc2/banc_V3.zip

Par contre, je vois sur ta capture d'écran que la colonne 5 n'est pas totalement vide

Est-ce normal?

Re bonsoir le forum d'entraide.

Oui c'est normal pour la colonne 5 car :

je peux choisir l'affichage soit je veux afficher que les valeurs vide soit l'affichage filtré sans valeur dans le champ "Imputation".

If Cells(i, 5) = vbEmpty Then ' Affiche Valeur Vide
If Cells(i, 5) >= vbEmpty Then ' Affiche Tout

De plus lors de l'impression les couleurs sont difficile à être lue lors d'une impression noir est blanc.

Doux le désir d'avoir des bordures comme l'exemple ci dessus.

cordialement

Franck

Re,

En effet, je n'y avais pas pensé.

Voici la nouvelle version : https://www.excel-pratique.com/~files/doc2/banc_V4.zip

Re bonsoir,

Je ne vois pas de différence entre le banc_V3.zip et banc_V4.zip

Pas de modification sur (De plus lors de l'impression les couleurs sont difficile à être lue lors d'une impression noir est blanc. )

J'ai une question sur la ligne

Sub filtre()
.Cells(derLig + 1, 9) = Fichier

Sub couleur()
If Cells(i - 1, 9) <> Cells(i, 9) Then

J'aimerai savoir si c'est possible de la déplacer en colonne 10 au lieu de 9?

Car si je modifie les dates reste écrite en noir

Cordialement

Franck

Bonjour franck, forum,

Autant pour moi, voici le bon fichier (tableau en noir et blanc) : https://www.excel-pratique.com/~files/doc2/banc_V5.zip

Teste ce fichier d'abord et redis-moi si tu veux modifier la colonne 9.

RE vba-new

C'est moins jolie mais plus lisible lors de l'impression

en tout ca merci des modifications, peux tu me donner les lignes a modifier pour décaler la colonne 9.

Franck :

Re,

Dans la procédure 'filtre' et dans l'ordre des lignes :

Remplace :

1.

                                .Cells(derLig + 1, 9) = Fichier

Par ça :

                                .Cells(derLig + 1, 10) = Fichier

2. (ligne identique)

                                .Cells(derLig + 1, 9) = Fichier

Par ça :

                                .Cells(derLig + 1, 10) = Fichier

3.

                    .Range("A" & debLigBis & ":G" & .Range("B65536").End(xlUp).Row & ",I" _
                           & debLigBis & ":I" & .Range("B65536").End(xlUp).Row).Interior.ColorIndex = 2
                    If .Range("B65536").End(xlUp).Row > debLigBis Then
                        .Range("A" & debLigBis & ":G" & .Range("B65536").End(xlUp).Row & ",I" _
                               & debLigBis & ":I" & .Range("B65536").End(xlUp).Row).Borders(xlEdgeBottom).Weight = xlThick

Par ça :

                    .Range("A" & debLigBis & ":G" & .Range("B65536").End(xlUp).Row & ",J" _
                           & debLigBis & ":J" & .Range("B65536").End(xlUp).Row).Interior.ColorIndex = 2
                    If .Range("B65536").End(xlUp).Row > debLigBis Then
                        .Range("A" & debLigBis & ":G" & .Range("B65536").End(xlUp).Row & ",J" _
                               & debLigBis & ":J" & .Range("B65536").End(xlUp).Row).Borders(xlEdgeBottom).Weight = xlThick

4.

        With .Sheets("Besoin")
            .Range("A" & debLig & ":G" & derLig).HorizontalAlignment = xlCenter
            With .Range("A" & debLig & ":G" & derLig & ",I" & debLig & ":I" & derLig).Borders(xlEdgeLeft)
                .Weight = xlThick
            End With
            With .Range("A" & debLig & ":G" & derLig & ",I" & debLig & ":I" & derLig).Borders(xlEdgeTop)
                .Weight = xlThick
            End With
            'With .Range("A" & debLig & ":G" & derLig & ",I" & debLig & ":I" & derLig).Borders(xlEdgeBottom)
            '    .Weight = xlThick
            'End With
            With .Range("A" & debLig & ":G" & derLig & ",I" & debLig & ":I" & derLig).Borders(xlEdgeRight)
                .Weight = xlThick
            End With
        End With

Par ça :

        With .Sheets("Besoin")
            .Range("A" & debLig & ":G" & derLig).HorizontalAlignment = xlCenter
            .Range("J:J").EntireColumn.AutoFit
            With .Range("A" & debLig & ":G" & derLig & ",J" & debLig & ":J" & derLig).Borders(xlEdgeLeft)
                .Weight = xlThick
            End With
            With .Range("A" & debLig & ":G" & derLig & ",J" & debLig & ":J" & derLig).Borders(xlEdgeTop)
                .Weight = xlThick
            End With
            'With .Range("A" & debLig & ":G" & derLig & ",J" & debLig & ":J" & derLig).Borders(xlEdgeBottom)
            '    .Weight = xlThick
            'End With
            With .Range("A" & debLig & ":G" & derLig & ",J" & debLig & ":J" & derLig).Borders(xlEdgeRight)
                .Weight = xlThick
            End With
        End With

Dans la procédure 'couleur' et dans l'ordre des lignes :

Remplace :

5.

    For i = 12 To Range("I65536").End(xlUp).Row

Par ça :

    For i = 12 To Range("J65536").End(xlUp).Row

6.

        If Cells(i - 1, 9) <> Cells(i, 9) Then

Par ça :

        If Cells(i - 1, 10) <> Cells(i, 10) Then

Si tu rencontres un problème, reviens.

RE

Alors une fois encore merci de ton aide

tu peux me dire où je peux me former sur la VBA?

merci

salut franck,

J'avais posé la même question à Dan lors de mes débuts en VBA il y a un peu plus de 3 mois et il m'a dit d'aller par ici : https://www.excel-pratique.com/forum/viewtopic.php?t=8069.

A cette liste, j'ajouterai qu'il est indispensable pour un débutant d'utiliser l'enregistreur de macro et de regarder le code derrière chaque action que tu fais dans excel.

Bonne chance à toi!

Bonjour vba-new

Encore merci de ton aide

Je te shouaite une très bonne fin de semaine.

Merci au Forum d 'excel-pratique.

Franck

RE bonjour le forum,

J'aimerais comprendre la macro TCD

ex capture :

pour rajouter les filtres tcd sur imputation/P0/CH/conformité:

ex macro :

Sub triTCD()
Dim derLigTCD As Long, debLigTCD As Long

    On Error GoTo triTCD_Error

    Application.ScreenUpdating = False
    debLigTCD = Range("A1").End(xlDown).Row
    derLigTCD = Range("A65000").End(xlUp).Row
    Sheets("TCD").Cells.Delete

    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
                                   "Besoin!R" & debLigTCD & "C1:R" & derLigTCD & "C2").CreatePivotTable TableDestination:= _
                                   "[banc.xls]TCD!R3C1", TableName:="TCD", _
                                   DefaultVersion:=xlPivotTableVersion10
    With Sheets("TCD")
        With .PivotTables("TCD")
            .AddFields RowFields:=Array("Date", "P0/CH")
            .PivotFields("P0/CH").Orientation = xlDataField
        End With
        .Activate
        .PivotTables("TCD").PivotSelect ""
        .PivotTables("TCD").Format xlReport6
    End With

    On Error GoTo 0
    Exit Sub

triTCD_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure triTCD of Module Module1"
End Sub

J'aimerai également utiliser la macro "filtre"

mais avec des fichiers qui se trouve sur des repertoires différents

Path = ThisWorkbook.Path & "\" ' On suppose que tous les classeurs visés sont dans le dossier de ce classeur.
 ChDir Path
Fichier = Dir(Path & "activité_banc*.xls") ' Filtrage des seuls classeurs Excel préfixé par "activité_banc" dans le dossier cible.

car mes fichiers se trouve exemple:

S:\Suivis\FaD\640x512 MW\640x512 MW-CH161.xls

S:\Suivis\FaD\MAPOD\MAPOD-CH206A.xls

dans tous les classeurs le besoin se trouve sur la feuille (FAD)

avec en titre colone A => année, en B => mois, en C => n° de la semaine

Merci

Franck

Salut franck,

Au lieu de :

                                 "Besoin!R" & debLigTCD & "C1:R" & derLigTCD & "C2").CreatePivotTable TableDestination:= _ 

Mets :

                                 "Besoin!R" & debLigTCD & "C1:R" & derLigTCD & "C7").CreatePivotTable TableDestination:= _ 

Et au lieu de :

            .AddFields RowFields:=Array("Date", "P0/CH") 

Mets :

            .AddFields RowFields:=Array("Date", "Imputation", "P0/CH", "Conformité")

Pour ton deuxième problème, je n'ai pas bien compris. Est-ce un autre fichier que banc?

Salut vba-new,

Merci pour la modification sur la zone de l'extraction du TCD ça fonctionne très bien.

Pour la dernière question oui c'est un autre fichier que j'aimerai faire sur la même base que celui que tu m'a développé (banc.exe)

Avec des regroupements sur dix fichiers que je veux ciblé dans des répertoires défini sachant que dans ces répertoires j'ai d'autre fichiers que je ne veux pas regarder.

exemple mais fichiers se trouve dans :

S:\Suivis\FaD\640x512 MW\640x512 MW-CH161.xls

S:\Suivis\FaD\MAPOD\MAPOD-CH206A.xls

Par contre la recherche de date est différente car dans tous les fichiers j'ai :

Besoin de trouve sur la feuille (FAD)

avec en titre colone A => année, en B => mois, en C => n° de la semaine

le besoin serait de regrouper tout les fichiers par rapport à l'année le mois le N° de semaine.

cordialament

Franck

Re,

clyver a écrit :

le besoin serait de regrouper tout les fichiers par rapport à l'année le mois le N° de semaine.

Franck, je te conseille d'ouvrir un nouveau fil pour ton autre fichier.

Je te dis ça parce que la macro filtre a été "bricolée" au fur et à mesure qu'il y avait des

problèmes, et comme ça fait un petit bout de temps que je te l'ai concoctée, difficile donc de

me rappeler tout ce qu'il y avait

De plus, je vais être amené, je crois, à moins participer au forum. Surtout sur des projets comme celui-là.

Je ne te lâche pas mais presque! Je garde quand même ton fichier sous le coude, au cas où.

Un autre conseil, fais une demande pas à pas! Asséner un :

le besoin serait de regrouper tout les fichiers par rapport à l'année le mois le N° de semaine.

n'optimisera peut-être pas les chances d'obtenir de l'aide

Bon courage!

Edit : je viens d'y penser, un site qui pourrait t'être très utile : http://boisgontierjacques.free.fr/

et plus particulièrement : http://boisgontierjacques.free.fr/pages_site/GestionOnglets.htm

RE vba-new,

Merci pour les liens il y a de quoi faire par là bas je regarde...

Merci à bientot

Amicalement Franck