XL 2010 Centralisation de données de plusieurs feuilles selon critères

[jeanba]

Bonjour à toutes et à tous,

Je souhaite copier et centraliser les données de plusieurs feuilles structurées de la même manière vers une seule du même classeur.

J'ai regardé à travers le forum, mes les cas traités de correspondent pas, sauf erreur de ma part, à ce que je recherche vraiment. En effet, dans mon cas, il y a répétition d'une donnée se trouvant à la même adresse dans le feuilles sources et qu'il faut répéter dans la feuille de destination tant qu'il y a des lignes de données à copier d'un mois donné.

Il serait plus simple de voir le fichier joint.

En vous en remerciant par avance!

Jeanba

 

[Compte Supprimé 979]

Bonjour Jeanba,

Voici ton fichier avec le code qui va bien ;-)

A+

 

[jeanba]

Bonjour Jeanba,

Voici ton fichier avec le code qui va bien ;-)

A+

Bonté divine!
Merci beaucoup Bruno, ça marche très bien!
Whaou!

(J'ai un projet plus vaste avec ce module là. Comment faire, qui contacter pour le développement, qui à donner une contribution pour ... J'ai contacté le webmaster depuis des lunes, pas de réaction. Que faire?..)

 

[jeanba]

PS: Dis BrunoM45,

Juste un souci pour intégrer ton code dans mon programme final: mon fichier comprend plusieurs autres feuilles qui ne sont pas concernées.
Y-t-il moyen de définir un ensemble de feuilles incluant "Centralisation" - genre {"centralisation", "PV"; "Pierre",...} et les désigner par "Name".
Ensuite, dire que toutes les feuilles qui ne feront pas partie de cette ensemble sont concernées par la centralisation?

Si non, comment faire autrement pour les exclure s'il te plaît?

Encore merci

 

[jeanba]

BrunoM45,

Voici l'erreur que j'ai en l'intégrant dans mon projet (je sais bien que le résultat sera pas bon car il prend des info même des classeurs non concernés...)
Merci

 

[klin89]

Bonsoir à tous,

Pour répondre au post #4, applique ceci :

Sub Exclure_feuilles()
Dim a, w As Worksheet
a = Array("Feuil1", "Feuil2") 'Nom des feuilles à exclure
    For Each w In Worksheets
        If IsError(Application.Match(w.Name, a, 0)) Then
            MsgBox "w.Name"
            'ton code
        End If
    Next
End Sub

klin89

 

[jeanba]

Post #6

Bonsoir klin89

Merci pour ta réponse rapide.
Malheureusement, ça marche pas.
Voir l'intégralité de mon code:

Sub CopieCentrale()
Dim DLig As Long, LigDeb As Long, LigFin As Long, Sht As Worksheet
Dim DLigD As Long, LigD As Long, ShtD, a As Worksheet
Dim NumM As Integer

' Définir la feuille de destination
Set ShtD = ThisWorkbook.Worksheets("Centralisation")
' Effacer la feuille de destination
DLigD = ShtD.Range("A" & Rows.Count).End(xlUp).Row
If DLigD > 1 Then ShtD.Range("A2:H" & DLigD).Clear
' Initialiser les variables
LigDeb = 2: LigFin = 1
' Nom des feuilles à exclure-
a = Array("Centralisation", "RECAP", "Plan comptable")
' Pour chaque feuille du classeur

For Each Sht In Worksheets
If IsError(Application.Match(Sht.Name, a, 0)) Then
MsgBox "sht.Name"
If Sht.Name <> a Then
' Récupérer le numéro du mois
NumM = ShtD.Range("A7").Value
' Récupérer la dernière ligne de la feuille
DLig = Sht.Range("A" & Rows.Count).End(xlUp).Row
' Copier la plage
Sht.Range("A8:E" & DLig).Copy
' Récupérer la ligne de départ
LigDeb = ShtD.Range("A" & Rows.Count).End(xlUp).Row + 1
' Coller les valeur dans la feuille de destination
ShtD.Range("B" & LigDeb).PasteSpecial xlPasteValues
' Calculer la ligne de fin pour inscrire le numéro du mois
LigFin = LigFin + (DLig - 2)
' Inscrire le mois sur les lignes
ShtD.Range("A" & LigDeb & ":A" & LigFin).Value = NumM
End If
End If
Next Sht
Call Trier
End Sub

Par ailleurs, les précisions suivantes sont à noter

1) le numéro de mois se trouve en "A7" dans chacune de mes feuilles de départ
2) les données à copier dans les feuilles de départ se trouvent toutes dans la plage "A8:G232"
Merci par avance et bonne journée dominicale à toutes et à tous!

Jeanba

 

[jeanba]

Bonjour à tous,

J'ai réussi, en tâtonnant à partir du code que m'a généreusement fourni BrunoM45, à obtenir quelque chose...
Mais, il insère 55 lignes d'espacement entre les mois sur la feuille de destinantion. Je crois que ça vient des 2 lignes suivantes:

LigDeb = ShtD.Range("A" & Rows.Count).End(xlUp).Row + 6 ' Récupérer la ligne de départ
LigFin = LigFin + (DLig - 2) ' Calculer la ligne de fin pour inscrire le numéro du mois

C'est bizarre, mais c'est ainsi: c'est seulement en combinant ces deux chiffres là (+6 d'une part et - 2 de l'autre), que je parviens à insérer les mois dans l'ordre souhaité... Mais, quelle solution pour ne pas avoir d'espace entre les mois s'il vous plaît?
Voic tout le code:

Sub CopieCentrale()
Dim DLig As Long, LigDeb As Long, LigFin As Long, Sht As Worksheet
Dim DLigD As Long, LigD As Long, ShtD As Worksheet
Dim NumM As Integer, ShtExcl As Sheets
Set ShtD = ThisWorkbook.Worksheets("Centralisation") ' Définir la feuille de destination
DLigD = ShtD.Range("A" & Rows.Count).End(xlUp).Row
If DLigD > 1 Then ShtD.Range("A2:H" & DLigD).Clear ' Effacer le contenu de la feuille de destination
LigDeb = 2: LigFin = 1 ' Initialiser les variables

' Pour chaque feuille du classeur parmi ceux compris dans liste ci-dessous, faire les actions suivantes:
For Each Sht In ThisWorkbook.Worksheets(Array("JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE"))
'Call Deverrouiller_Feuille ' Ouvrir l'accès en écriture de la feuille source
NumM = Sht.Range("A7").Value ' Récupérer le numéro du mois
DLig = Sht.Range("A" & Rows.Count).End(xlUp).Row ' Récupérer la dernière ligne de la feuille
Sht.Range("A8:G232").Copy ' Copier la plage
LigDeb = ShtD.Range("A" & Rows.Count).End(xlUp).Row + 6 ' Récupérer la ligne de départ
ShtD.Range("B" & LigDeb).PasteSpecial xlPasteValues ' Coller les valeurs autres que le mois dans la feuille de destination
LigFin = LigFin + (DLig - 2) ' Calculer la ligne de fin pour inscrire le numéro du mois
ShtD.Range("A" & LigDeb & ":A" & LigFin).Value = NumM ' Inscrire le mois sur les lignes de la feuille de destination
'Call Proteger_Feuille
Next Sht

Call Trier

End Sub

Merci encore

 

[mapomme]

Bonjour à tous,

Un essai en pièce jointe.

J'ai considéré que le nom des feuilles "Mois" était correctement orthographié (notamment avec les bons accents) soit : Janvier, Février, Mars, Avril, Mai, Juin, Juillet, Août, Septembre, Octobre, Novembre, Décembre.

Le test utilisé pour décider si une feuille wsh correspond ou non à un mois est :

If IsDate("1-" & wsh.Name) then

Le mois est donné par :

Month("1-" & wsh.Name)

 

[jeanba]

Bonjour mapomme,

Dis donc, qu'est-ce qu'on apprend des trucs tous les jours!
Merci pour ta contrib!
Ecoute, sur le fichier exemple, tn truc est parfait, à ceci près qu'il copie vraiment tout, y compris les formules.
Or, moi, j'ai besoin d'un collage spécial valeurs.

D'autre part, j'ai découvert qu'en l'adaptant dans mon fichier projet final, il y a AUSSI des séparations de lignes en passant d'un mois à un autre...

Je ne sais franchement pas à quoi cela est d^. Mais le langage informatiue étant binaire, il y a forcément un truc dans les différents codes que j'ai bricolés ci-dessus qui explique cela..

Je suis sûr qu'il existe dans notre gande galaxie XLNaute, quelqu'un qui va m'aider à surmonter ça...

Dans cette attente,
Merci d'avance les amis!

Jeanba

 

[mapomme]

Bonsoir creolia,

Pour la copie en valeur, remplacer la ligne:

wsh.Range("a3:e" & derlig).Copy xrg

par les deux lignes:

 wsh.Range("a3:e" & derlig).Copy
xrg.PasteSpecial xlPasteValues

 

[jeanba]

Bonjour mapomme,

C'est excellent! ça marche le truc!
Par contre, contrairement au code de BrunoM45 où, au lieu de tester si la feuille est date ou pas, j'avais directement la plage de feuilles ("Array"), le programme met plus de temps à s'exécuter...

Est-ce qu'il est possible d'ajouter ces instructions:
=> Pour chaque feuille, si la plage "A8" est vide, ne pas traiter cette feuille et passer à la suivante (si cette suivante est la dernière, fin de traitement)

Merci mapomme!

 

[gosselien]

=> Pour chaque feuille, si la plage "A8" est vide, ne pas traiter cette feuille et passer à la suivante (si cette suivante est la dernière, fin de traitement)
Merci mapomme!

Bonjour
"A8" ??? je suppose que tu veux dire la dernière ligne occupée dans l'onglet concerné ?
P.

 

[mapomme]

Bonjour jeanba,

Tout comme gosselien , je ne comprends pas ce qui distingue la ligne A8 des autres lignes.

En tout cas, dans le fichier joint, le test de A8 est réalisé (donc seul novembre est recopié).

 

[jeanba]

Bonjour mapomme et gosslien,

En fait, mon problème est le suivant:

Je tiens 12 feuilles de données structurées de la même manière. C'est à dire que la plage de données à copier est [A8 à G&End of file].
Je reporte en ligne 2 (cellule "E7"), le solde du mois précédent.

J'utilise le code de klin89 avec tous les améliorations que la communauté a apportées (creolia, mapomme et..) et comme je l'ai dit ce matin, ça fonctionneplutôt bien. Seul souci, en décembre (feuille sans donnée encore), il copie aussi la ligne de report de solde alors qu'il est sensé ne copier que les données de la plage [A8 à G&End of file] qui est en dessous!!! Donc, pour contourner le problème, j'ai pensé vous proposer de tester si la cellule "A8" est vide [l'utilisateur n'a encore rien inscrit dans cette plage donc], hé bien, on ne copie rien vue qu'il n'y a pas de donnée entrée... Sauf s'il y a une autre solution...

En tout cas, voici le code:

Sub CopieCentrale()
Dim wsh As Worksheet, derlig&, xrg As Range

Application.ScreenUpdating = False
Worksheets("Centralisation").Range("A2:H" & Rows.Count).ClearContents
For Each wsh In Worksheets
If IsDate("1-" & wsh.Name) Then
With Worksheets("Centralisation")
derlig = wsh.Cells(Rows.Count, "A").End(xlUp).Row
If derlig > 2 Then
Set xrg = .Cells(Rows.Count, "B").End(xlUp).Offset(1)
wsh.Range("A8:G" & derlig).Copy
xrg.PasteSpecial xlPasteValues
xrg.Offset(, -1).Resize(wsh.Range("A8:G" & derlig).Rows.Count) = Month("1-" & wsh.Name)
End If
End With
End If
Next wsh
Call Trier_Centralisation
Call Police_Centralisation
End Sub