extraire toutes les donnees des feuilles sauf une

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

olive323

XLDnaute Occasionnel
Bonjour a tous

Je souhaite extraire les données de toutes les feuilles, dans la feuille "recap" sauf les données de la feuille ("MENU").

mais je bog

cordialement

olive323


Sub grouper()

Début = Range("H1")
Fin = Range("k1")
If Fin < Début Then MsgBox "votre date de fin est inférieure à votre date de début": Exit Sub
Dim sht As Worksheet
For Each sht In Worksheets
'Debug.Print sht.Name
If sht.Name <> "MENU" Then
'If sht.Name = "RECAP" Then Exit For



With Sht
Set liste = CreateObject("scripting.dictionary")
Set liste1 = CreateObject("scripting.dictionary")
Set liste2 = CreateObject("scripting.dictionary")
For Each C In .Range("B3:B" & .Range("B" & Rows.Count).End(xlUp).Row)

If C.Value >= Début And C.Value <= Fin Then


liste(C.Value & "#" & C.Offset(, -1)) = liste(C.Value & "#" & C.Offset(, -1)) + C.Offset(, 9)
liste1(C.Value & "#" & C.Offset(, -1)) = liste1(C.Value & "#" & C.Offset(, -1)) + C.Offset(, 8)
liste2(C.Value & "#" & C.Offset(, -1)) = liste2(C.Value & "#" & C.Offset(, -1)) + C.Offset(, 6)
End If
Next C
Sheets("RECAP").Range("A2:E65536").ClearContents
X = 2
For Each elem In liste.Keys
Sheets("RECAP").Range("A" & X).Resize(1, 2) = Split(elem, "#")
X = X + 1
Next elem
Sheets("RECAP").Range("C2:C" & liste.Count + 1) = Application.Transpose(liste.Items)
Sheets("RECAP").Range("D2😀" & liste.Count + 1) = Application.Transpose(liste1.Items)
Sheets("RECAP").Range("E2:E" & liste.Count + 1) = Application.Transpose(liste2.Items)
End With
Sheets("RECAP").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("A2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
Range("A2").Select
End If
Next
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
180
Réponses
3
Affichages
665
Retour