Private Sub CommandButton1_Click() 'Copier la source
Dim fichier$, P As Range, nlig&, c As Range, n%, a, b, i%, c3 As Range, c1 As Range, c2 As Range, Q As Range, h%
fichier = ThisWorkbook.Path & "\REPARTITION _ LIVRAISON SOURCE.xlsx" 'chemin à adapter
If Dir(fichier) = "" Then MsgBox "Fichier SOURCE introuvable !", 48: Exit Sub
Set P = [B1:L67] 'tableau de base
nlig = P.Rows.Count
Application.ScreenUpdating = False
P.Offset(nlig).Resize(Rows.Count - nlig).Delete xlUp 'RAZ
With Workbooks.Open(fichier).Sheets(1)
Set c = .Cells(1)
For n = 1 To Application.CountIf(.Columns(1), "Point de livraison")
If n > 1 Then
P.Copy P.Offset(nlig) 'copier-coller
Set P = P.Offset(nlig)
End If
P(5, 3).Resize(3) = ""
P.Rows(11).Resize(8, 8) = ""
P.Rows(22).Resize(11, 8) = ""
P.Rows(36).Resize(11, 8) = ""
P.Rows(49).Resize(2, 8) = ""
Set c = .Columns(1).Find("Point de livraison", c, xlValues, xlWhole)
P(2, 10) = Replace(c(1, 2), " ND ", " NOTRE DAME ") 'lieu
P(5, 3) = c(0, 2) 'date
P(6, 3) = c(1, 2) 'point de livraison
P(7, 3) = c(2, 2) 'camion
Set c3 = .Columns(1).Find("*Cumul*", c)(2)
'---les 3 zones des copies---
a = Array("ADULTE", "MATERNELLE", "PRIMAIRE")
b = Array(11, 22, 36) 'n° de la 1ère ligne à remplir
For i = 0 To UBound(a)
Set c1 = .Columns(2).Find(a(i), c(1, 2))
If Not c1 Is Nothing Then If c1.Row > c3.Row Or c1.Row < c.Row Then Set c1 = Nothing
If Not c1 Is Nothing Then
Set c2 = .Columns(1).Find("Plats", c1(3, 0))
If c2 Is Nothing Then Set c2 = c3
If c2.Row > c3.Row Or c2.Row < c.Row Then Set c2 = c3
Set Q = .Range(c1(3, 0), c2(-1))
h = Q.Rows.Count
P(b(i), 1).Resize(h) = Application.Trim(Q.Value) 'SUPPRESPACE
P(b(i), 5).Resize(h) = Q.Columns(2).Value
P(b(i), 7).Resize(h) = Application.Trim(Q.Columns(3).Value)
P(b(i), 8).Resize(h) = Q.Columns(4).Value
End If
Next i
'---Cumul des plats non conditionnés---
Set Q = c3.Resize(2)
P(49, 1).Resize(2) = Q.Value
P(49, 5).Resize(2) = Q.Columns(2).Value
P(49, 7).Resize(2) = Q.Columns(3).Value
P(49, 8).Resize(2) = Q.Columns(4).Value
P(50, 7) = Replace(P(50, 7), "Effectif prévu :", "")
Next n
.Parent.Close False
End With
End Sub