Option Compare Text 'la casse est ignorée
Private Sub Worksheet_Activate()
Dim base As Range, dest As Range, t, t1, rest(), ub&, deb&, i&, lig&, x, j%
Application.ScreenUpdating = False
On Error Resume Next
Set base = Sheets("Base").UsedRange.Offset(1)
base.Parent.ShowAllData 'si la feuille est filtrée
base.Sort base.Columns(4), xlAscending, Header:=xlNo 'tri sur PO number
Set dest = Me.UsedRange.Offset(1)
Me.ShowAllData 'si la feuille est filtrée
dest.Sort dest.Columns(15), xlAscending, Header:=xlNo 'tri sur PO number
On Error GoTo 0
t = base 'matrices, plus rapide
t1 = dest
ReDim rest(1 To Application.Max(UBound(t), UBound(t1)), 1 To UBound(t1, 2))
ub = UBound(t1)
deb = 1
For i = 1 To UBound(t)
'---copie des colonnes communes---
rest(i, 1) = t(i, 1)
rest(i, 2) = t(i, 5)
rest(i, 9) = t(i, 3)
rest(i, 15) = t(i, 4)
rest(i, 16) = t(i, 16)
rest(i, 17) = t(i, 15)
rest(i, 18) = t(i, 14)
rest(i, 19) = t(i, 10)
rest(i, 20) = t(i, 12)
rest(i, 24) = t(i, 7)
rest(i, 29) = t(i, 6)
rest(i, 30) = t(i, 7)
rest(i, 31) = t(i, 11)
'---détermination de lig---
lig = 0
x = t(i, 4) 'PO number à rechercher
For deb = deb To ub
If t1(deb, 15) = x Then lig = deb: deb = deb + 1: Exit For
If t1(deb, 15) > x Then Exit For
Next deb
'---copie des colonnes remplies manuellement---
If lig Then
For j = 3 To 8
rest(i, j) = t1(lig, j)
Next j
For j = 10 To 14
rest(i, j) = t1(lig, j)
Next j
For j = 21 To 23
rest(i, j) = t1(lig, j)
Next j
For j = 25 To 28
rest(i, j) = t1(lig, j)
Next j
End If
Next i
'---restitution---
dest.Resize(UBound(rest), UBound(rest, 2)) = rest
End Sub