Bonsoir Anber, le Forum
Sans avoir fait de test rééls, mais juste pour le concept de l'algo :
Option Explicit
Sub Page()
Dim WS As Variant
Dim TabSource As Variant
Dim Cell As Range
Dim i As Integer
Dim Col As Byte
Col = 11
With Sheets("TheSheetCible")
TabSource = .Range("J3:J1167")
For Each WS In Array("Moa", "Mov", "PP", "Che")
For Each Cell In Sheets(WS).Range("N5
K5")
For i = 1 To UBound(TabSource)
If Cell = TabSource(i, 1) Then
.Cells(i + 2, Col) = Cell.Offset(1, 0)
End If
Next i
Next Cell
Col = Col + 1
Next WS
End With
End Sub
Par contre, même si je pense que çà devrait accélérer un peu, le process risque tout de même d'être long, il faudrait voir à tout gérer par Array, mais bon là je suis en repos
Bonne Soirée
@+Thierry