Option Explicit
Option Base 1
Sub Synthese()
Dim Wk As Workbook
Dim ShPlan As Worksheet, ShSyn As Worksheet
Dim lPlan As Long, lSyn As Long
Dim i As Long, j As Integer, k As Integer
Dim cSyn(), a, c
Dim d As Object
Set Wk = ThisWorkbook
Set ShPlan = Wk.Sheets("Planning"): Set ShSyn = Wk.Sheets("Synthese")
lPlan = ShPlan.[a65000].End(xlUp).Row: lSyn = ShSyn.[c65000].End(xlUp).Row
cSyn = Array(20, 12, 6, 19, 1, 2, 3, 13, 17)
Set d = CreateObject("Scripting.Dictionary")
With ShPlan
j = 0
For i = lPlan To 2 Step -1
If .Cells(i, 20).Value = "OK" Then Exit For
If .Cells(i, 12).Value = "EUI" Then
j = j + 1
For k = 1 To 9: d(j) = d(j) & .Cells(i, cSyn(k)).Text & "|": Next k
End If
Next i
End With
With ShSyn
If lSyn > 2 Then .Rows("3:" & lSyn).EntireRow.Delete
For Each c In d.keys
a = Split(d(c), "|")
.Cells(2 + c, 3).Resize(, UBound(a) - 1).Value = a
Next
End With
End Sub