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
34
35
36
37
38
39
40
41
42
| Sub Repartition()
Dim DerLig As Long, i As Long, j As Long
Application.ScreenUpdating = False
DerLig = Range("A" & Rows.Count).End(xlUp).Row
'Marquage pour modifier l'ordre des données et retrouver dans l'ordre initial à la fin
Range("D2").Value = "1"
Range("D2").AutoFill Destination:=Range("D2:D" & DerLig), Type:=xlFillSeries
'Tri par N° fournisseur et par source
Range("A2:D" & DerLig).Sort [A1], 1
Range("A2:D" & DerLig).Sort [B1], 1
Lig = 2
For i = 2 To DerLig
If Cells(i, "B") <> Cells(i + 1, "B") Then
Cells(Lig, "E") = Cells(i, "B")
Cells(Lig, "F") = Cells(i, "C")
Cells(Lig, "G") = Cells(i, "A")
Lig = Lig + 1
Else
Cells(Lig, "E") = Cells(i, "B")
Cells(Lig, "F") = Cells(i, "C")
Cells(Lig, "G") = Cells(i, "A")
j = i + 1
Do While Cells(j, "B") = Cells(i, "B")
If Cells(j, "A") <> Cells(j - 1, "A") Then
Cells(Lig, "G") = Cells(Lig, "G") & ", " & Cells(j, "A")
End If
j = j + 1
Loop
Lig = Lig + 1
i = i + 1
End If
Next i
Range("E1").Value = Range("B1").Value
Range("F1").Value = Range("C1").Value
Range("G1").Value = Range("A1").Value
'Tri pour retrouver la configuration initiale
Range("A2:D" & DerLig).Sort [D1], 1
Columns(4).ClearContents
End Sub |
