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
32
33
| Sub Test1()
Dim EnTete(), k As Byte, Col As Byte
Dim Lig As Long, i As Long, C As Range
Application.ScreenUpdating = False
EnTete = Array("LIGNE 1", "LIGNE 2", "LIGNE 3", "LIGNE 4", "LIGNE 5")
PremLig = Cells.Find("*", , , , xlByRows, xlNext).Row
'PremLig = ActiveSheet.UsedRange.Row
For k = LBound(EnTete) To UBound(EnTete)
Col = Rows(PremLig).Find(What:=EnTete(k), LookAt:=xlWhole).Column
'Lig = Cells(Rows.Count, Col).End(xlUp).Row
Lig = 42
Range(Cells(PremLig + 1, Col), Cells(Lig, Col + 1)).Copy Sheets("Feuil3").[A65536].End(xlUp).Offset(1, 0)
Next k
With Sheets("Feuil3")
For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
If .Cells(i, 1) = "" Then .Rows(i).Delete
Next i
Set mondico = CreateObject("Scripting.Dictionary")
Set mondico1 = CreateObject("Scripting.Dictionary")
For Each C In .Range("A2:A" & .Range("A65536").End(xlUp).Row)
'supprime l'espace à droite
C.Value = RTrim(C.Value)
mondico(C.Value) = mondico(C.Value) + 1
mondico1(C.Value) = mondico1(C.Value) + C.Offset(, 1).Value
Next C
.Range("E1").Resize(1, 3) = Array("Titres", "Volumes", "Poids")
.Range("E2").Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
.Range("F2").Resize(mondico.Count, 1) = Application.Transpose(mondico.items)
.Range("G2").Resize(mondico1.Count, 1) = Application.Transpose(mondico1.items)
.Range("E2:G" & .Range("G65536").End(xlUp).Row).Sort Key1:=.Range("G2"), Order1:=xlDescending, Header:=xlNo
End With
Application.ScreenUpdating = True
End Sub |
