Sub Copier()
Dim d As Object, F As Worksheet, F1 As Worksheet, tablo, ncol%, i&, x$, tablo1, ajout(), n&, j%, nn&
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
Set F = Sheets("Ent. Sel.")
Set F1 = Sheets("Liste EDP")
If F.FilterMode Then F.ShowAllData 'si la feuille est masquée
If F1.FilterMode Then F1.ShowAllData 'si la feuille est masquée
tablo = F.Range("C3:X" & F.Range("D" & F.Rows.Count).End(xlUp).Row)
ncol = UBound(tablo, 2)
For i = 2 To UBound(tablo)
x = Trim(tablo(i, 2))
If x <> "" Then d(x) = i 'la ligne est mémorisée
Next i
tablo1 = F1.Range("G3:AC" & F1.Range("I" & F1.Rows.Count).End(xlUp).Row)
ReDim ajout(1 To F.Rows.Count, 1 To ncol)
For i = 2 To UBound(tablo1)
If UCase(tablo1(i, 1)) = "O" Then
x = Trim(tablo1(i, 3))
If d.exists(x) Then
n = d(x)
For j = 1 To ncol
tablo(n, j) = tablo1(i, j + 1)
Next j
Else
nn = nn + 1
For j = 1 To ncol
ajout(nn, j) = tablo1(i, j + 1)
Next j
End If
End If
Next i
'---restitution---
n = UBound(tablo)
Application.ScreenUpdating = False
F.[C3].Resize(n, ncol) = tablo
If nn Then
F.[C3].Offset(n).Resize(nn, ncol) = ajout
With F.[A3].Offset(n).Resize(nn, 2)
.Interior.ColorIndex = 6 'jaune
.Borders.Weight = xlHairline 'bordures
.Validation.Delete
.Validation.Add xlValidateList, Formula1:="O,N"
End With
End If
F.Columns.AutoFit 'ajuste les largeurs
F.Activate
End Sub