Regrouper dans une base de données

[Caninge]

Bonjour à tous,

Dans mon application je posséde :

1 feuille (Base de données)
3 feuilles (A;B;C)
1 feuille (Cumul)

Comment faire pour regrouper toutes les entrées des feuilles A B C dans la feuille cumul .

Merci

 

[CBernardT]

bonjour Caninge et le forum

Essai de transfert des feuilles A, B, C vers la feuille récapitulative "Cumul".

Un bouton permet de commander l'opération.

Il est possible d'automatiser la commande par une macro placée dans le module de la feuille "Cumul" en lieu est place de la procédure du bouton :

Private Sub CommandButton1_Click()
Transfert
End Sub

ou en dessous si l'on veut conserver les deux mises à jour.

Private Sub Worksheet_Activate()
Transfert
End Sub


Cordialement

CBernardT

 

[Caninge]

Bonjour,

Je prends connaissance du fichier que tu m'as fais.

Oui je voudrais bien que tout se fasse automatiquement comme tu me l'à noté.

je vais essayer.

Je te tiens au courant

Merci beaucoup !!!

 

[Caninge]

Bonjour

J'ai appliqué la macro sur mon projet.

J'ai même rajouté 4 lignes pour trier dans la feuille "Récapitulatif" les codes et quantités.

Ca marche bien, par contre si il n'y a rien dans les feuilles A B et C,
Code Qté Qté Qté s'affichent dans les cellules D7:C7 ??

je t'envoie la macro transformé.

Merci d'avance!!

Sub Transfert()
Dim Tbl As Range
Dim MyRange As Range
Dim MyPlage As Range
Dim C As Range, Cbis As Range
Dim j As Byte
Application.ScreenUpdating = False
'Effacement des anciennes données du tableau
Worksheets("Récapitulatif").Range("B12", "C100").ClearContents
'Mise en boucle de toutes les feuilles sauf les feuilles "Cumul" et "base"
For j = 3 To Sheets.Count
'Déclaration des plages à consulter
Set MyRange = Range(Sheets(j).Range("B12"), Sheets(j).Range("B66").End(xlUp))
Set MyPlage = Sheets("Récapitulatif").Range("Plage")
For Each C In MyRange
If Application.CountIf(MyPlage, C) = 0 Then ' Boucle de mise en tableau des articles absents et de leurs quantités
If Sheets("Récapitulatif").Range("B12") = "" Then ' inscription de l'article
Sheets("Récapitulatif").Range("B12") = C
Sheets("Récapitulatif").Range("B12").Offset(0, 1) = C.Offset(0, 1) 'Inscription de la quantité
Else
Sheets("Récapitulatif").Range("B100").End(xlUp).Offset(1, 0) = C ' inscription de l'article
Sheets("Récapitulatif").Range("B100").End(xlUp).Offset(0, 1) = Sheets("Récapitulatif").Range("B100").End(xlUp).Offset(0, 1) + C.Offset(0, 1) 'Inscription de la quantité
End If
Else
For Each Cbis In MyPlage 'Boucle de mise en tableau des quantités des articles déjà présents
If Cbis = C Then
Cbis.Offset(0, 1) = Cbis.Offset(0, 1) + C.Offset(0, 1) 'Inscription de la quantité
Exit For
End If
Next Cbis
End If
Next C
Next j

Range("B12:c100").Select
Selection.Sort Key1:=Range("B12"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.ScreenUpdating = True

Range("A1").Select

End Sub

 

[CBernardT]

bonsoir Caninge

petit bug des tableaux vides corrigé.

Macro d'automatisation installée ;

La mise à jour du tableau s'effectue à l'activation de la feuille Cumul.

Le bouton conservé, permet de commander manuellement l'opération.

Le tri croissant des codes est mis en place.


Cordialement

CBernardT

 

[Caninge]

Bonjour


Je regarde le correctif et l 'applique sur mon fichier.

Je te tiens au courant

Merci et à bientôt !!

Caninge

 

[Caninge]

Oui Bonjour

Tout marche au poil !!!!

Je crois que je viens de faire un petit pas de plus en programmation, pas un pas de géant bien sur.

Merc pour ton aide

trés reconnaissant

A bientôt

Caninge