Macro de tri entre plusieurs feuilles de calculs

Calahann

XLDnaute Nouveau
Bonjour tout le monde, je souhaite réaliser un outil Excel pour simplifier ma tache au travail mais je ressent quelques difficultés pour la mettre en œuvre.

Je souhaite faire un tableau récapitulatif tirant des informations dans deux feuilles de calculs et les regroupant sur une 3éme.
Mon fichier Excel est composé de 3 feuilles de calcul : Onglet1, Onglet2 et Récapitulatif.
Dans mes onglets 1 et 2 sont rentrées des listes de matériels et sur chaque ligne je mets une quantité manuellement dans la colonne M.
Je souhaite intégrer une macro sur la feuille Récapitulatif pour faire un tri en fonction de la quantité de cette façon :

Activé Onglet1
Faire une boucle pour toutes les cellules de la colonne M avec l’opération :
Si CelluleM1,2,3,…<>0 alors copier la ligne sur ma feuille Récapitulatif Sinon rien
Sauté une ligne
Activé Onglet2
Et faire la même opération pour venir chercher toutes les lignes de matériel ou les quantités sont différentes de zéro
Faire une boucle pour toutes les cellules de la colonne M avec l’opération :
Si CelluleM1,2,3,…<>0 alors copier la ligne sur ma feuille Récapitulatif Sinon rien

Et ainsi ma feuille Récapitulatif regroupe toutes les lignes des Onglet1 et 2 dont les quantités rentrées dans les cellules de la colonne M sont différentes de zéro.
 

Calahann

XLDnaute Nouveau
Re : Macro de tri entre plusieurs feuilles de calculs

Actuellement je viens chercher les donnees dans mes onglets, je l'ai copies sur le tableau recap pour toutes les lignes ou quantités différentes de zéro mais le probléme c'est qu'il m'ecrase les lignes en recommencant la manip pour chaque onglet donc il faudrait que je trouve comment copier mes lignes d'une feuille, puis sauter une ligne et commencer a copier les lignes de la deuxiéme feuille et ainsi de suite pour avoir la totalité de mes 4 onglets dans mon tableau recap.
Voici mon programme actuel :
Sub Récapitulatif()


Range("A1:Z500").Delete

Sheets("Récapitulatif").Activate

Dim i As Integer




For i = 1 To 50

If Sheets("Mise à la Terre").Range("M" & i) <> 0 Then Range("A" & i & ":X" & i).Value = Sheets("Mise à la Terre").Range("A" & i & ":X" & i).Value

Next i

For lin = Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If Rows(lin).Find("*") Is Nothing Then Rows(lin).Delete
Next lin

For i = 1 To 50

If Sheets("Colliers de câblage").Range("M" & i) <> 0 Then Range("A" & i & ":X" & i).Value = Sheets("Colliers de câblage").Range("A" & i & ":X" & i).Value

Next i

For lin = Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If Rows(lin).Find("*") Is Nothing Then Rows(lin).Delete
Next lin


For i = 1 To 50

If Sheets("CDC").Range("M" & i) <> 0 Then Range("A" & i & ":X" & i).Value = Sheets("CDC").Range("A" & i & ":X" & i).Value

Next i

For lin = Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If Rows(lin).Find("*") Is Nothing Then Rows(lin).Delete
Next lin


For i = 1 To 50

If Sheets("RELAIS COMMANDE").Range("M" & i) <> 0 Then Range("A" & i & ":X" & i).Value = Sheets("RELAIS COMMANDE").Range("A" & i & ":X" & i).Value

Next i

For lin = Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If Rows(lin).Find("*") Is Nothing Then Rows(lin).Delete
Next lin



End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 203
Messages
2 086 196
Membres
103 153
dernier inscrit
SamirN