extraire toutes les donnees des feuilles sauf une

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

Cliquez pour agrandir...