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 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
| Sub Remplissage()
Dim f1 As Worksheet, f2 As Worksheet
Dim i As Long, j As Long, l As Long, k As Long, c As Long, Col As Long
Dim p As Object, m As Object
Application.ScreenUpdating = False
Windows("Liste_Source_fruit.xlsx").Activate
Set f1 = Sheets("Liste_source_des_fruits")
Set f2 = Sheets("Liste_des_pays")
DerLig_Pays = f2.Range("A" & Rows.Count).End(xlUp).Row
DerLig_Site = f1.Range("A" & Rows.Count).End(xlUp).Row
ReDim Mois(DerLig_Site) As String
ReDim Fruit(DerLig_Site) As String
For i = 2 To DerLig_Pays
Pays = f2.Cells(i, "A")
For j = 2 To DerLig_Site
l = j
Do While f1.Cells(l, "A") = Pays
If f1.Cells(l, "D") <> "" Then
Mois(l - 1) = f1.Cells(l, "B")
Fruit(l - 1) = f1.Cells(l, "D")
End If
l = l + 1
Loop
Next j
'recopie dans fichier "Dash_fruit"
l = l - 1
Windows("Dash_Fruit.xlsm").Activate
DerCol_f1 = Range("D2").End(xlToRight).Column 'Dernière colonne du tableau
Set p = Columns(1).Find(Pays)
Range(Cells(p.Row, "D"), Cells(p.Row, DerCol_f1)).ClearContents 'effacement des précédents relevés
For k = 1 To l
If Mois(k) <> "" Then
Set m = Rows(1).Find(Mois(k))
c = m.Column
If Not m Is Nothing Then
Do While Cells(2, c) <> Fruit(k)
c = c + 1
Loop
Cells(p.Row, c) = Cells(p.Row, c) + 1
Mois(k) = ""
Fruit(k) = ""
End If
End If
Next k
For Col = 4 To DerCol_f1
If Cells(p.Row, Col) <> "" Then Cells(p.Row, Col).Value = "Ok" & Chr(10) & Cells(p.Row, Col).Value
Next Col
Windows("Liste_Source_fruit.xlsx").Activate
Next i
Windows("Dash_Fruit.xlsm").Activate
Set m = Nothing
Set p = Nothing
Set f1 = Nothing
Set f2 = Nothing
End Sub |
Partager