[VBA-E] Regroupement de données

Bjr,

Je possède différente valeurs dans différentes Feuils Excel.

Toutes ces Feuils ont les memes colonnes : Date/NIMP/Référence mais pas la meme quantité de valeurs.

Mon but est de réaliser un balayage de toutes ces feuilles par ordre croissant afin de regrouper, dans une feuil unique possédant les 3 colonnes citées précédement, toutes les valeurs des Feuils.

J'espere avoir été assez clair.

Merci à tous.

tiens un peu de code ...

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

Sub Macro1() Dim fd As Worksheet ' Feuille destination Dim fs As Worksheet 'Feuille source (de la copie) Set fd = ThisWorkbook.Sheets("feuil2") 'On défini ici la feuille destination 'Efface Feuille destination fd.Cells.Clear fd.Activate 'Ecriture de l'entête sur Feuille destination fd.Cells(1, 1) = "Date" fd.Cells(1, 2) = "NIMP" fd.Cells(1, 3) = "Référence " For Each fs In ThisWorkbook.Worksheets If fs.Name <> fd.Name Then ' on va pas copier la feuille destination ... Debug.Print "Copie des données de " & fs.Name fs.Range(fs.Cells(2, 1), fs.Cells(1, 1).SpecialCells(xlLastCell)).Copy 'On copie à partir 1° ligne   fd.Cells(fd.Cells(1, 1).CurrentRegion.Rows.Count + 1, 1).Select ' On se place sur cellule suivante le tableau récap fd.Paste ' on colle... End If Next   End Sub

---

bon courage ... :roll: :wink:

Génial ca marche j'ai comme meme un peu modifié la macro.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

Sub Macro2()   Dim fd As Worksheet ' Feuille destination Dim fs As Worksheet 'Feuille source (de la copie)   Sheets.Add Set fd = ThisWorkbook.ActiveSheet 'On défini ici la feuille destination   'Efface Feuille destination   fd.Activate   'Ecriture de l'entête sur Feuille destination   fd.Cells(1, 1) = "Date" fd.Cells(1, 2) = "NIMP" fd.Cells(1, 3) = "Référence "   For Each fs In ThisWorkbook.Worksheets   If fs.Name <> fd.Name Then ' on va pas copier la feuille destination ... Debug.Print "Copie des données de " & fs.Name fs.Range(fs.Cells(2, 1), fs.Cells(1, 1).SpecialCells(xlLastCell)).Copy 'On copie à partir 1° ligne fd.Cells(fd.Cells(1, 1).CurrentRegion.Rows.Count + 1, 1).Select ' On se place sur cellule suivante le tableau récap fd.Paste ' on colle...   End If   Next   End Sub

---

Par contre j'avais oublié d'indiquer que je ne voulais pas prendre la Feuil1 et la Feuil "Calendrier" dans la boucle.

Si je fais un and if ca devrait fonctionner.

Je vais essayer ca.

Merci encore.

J'ai essayé le code suivant mais ca ne fonctionne pas :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

Sub Macro2()   Dim fd As Worksheet ' Feuille destination Dim fs As Worksheet 'Feuille source (de la copie)   Sheets.Add Set fd = ThisWorkbook.ActiveSheet 'On défini ici la feuille destination   'Efface Feuille destination   fd.Activate   'Ecriture de l'entête sur Feuille destination   fd.Cells(1, 1) = "Date" fd.Cells(1, 2) = "NIMP" fd.Cells(1, 3) = "Référence "   For Each fs In ThisWorkbook.Worksheets   If fs.Name <> fd.Name And fs <> Sheets("Feuil1") and fs <> Sheets("Calendrier") Then ' on va pas copier la feuille destination ... Debug.Print "Copie des données de " & fs.Name fs.Range(fs.Cells(2, 1), fs.Cells(1, 1).SpecialCells(xlLastCell)).Copy 'On copie à partir 1° ligne fd.Cells(fd.Cells(1, 1).CurrentRegion.Rows.Count + 1, 1).Select ' On se place sur cellule suivante le tableau récap fd.Paste ' on colle...   End If   Next   End Sub

---

Je comprends pas pourquoi??

Citation:

---

If fs.Name <> fd.Name And fs <> Sheets("Feuil1") and fs <> Sheets("Calendrier") Then

---

Tu ne vois rien d'anormal ? Tu devrais te relire...

Allez... essaie avec

Code:

---

If fs.Name <> fd.Name And fs.name <> "Feuil1" and fs.name <> "Calendrier" Then

---

A+

Ah la j'avoue dsl mais Vendredi donc un peu fatigué.

Merci beaucoup.