Sub TestCopie()
With Sheets("Feuil1")
fin = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne
tabdata = .Range("A2:Q" & fin).Value 'on met toute la feuille dans un tablo
End With
NbLignes = 1 'initialisation
For i = LBound(tabdata, 1) + 1 To UBound(tabdata, 1) 'on cherche le numéro max de ligne base action
NbLignes = WorksheetFunction.Max(NbLignes, tabdata(i, 1))
Next i
ReDim tabfinal(1 To NbLignes, 1 To 1) 'on dimensionne le tablo final de ce nombre de lignes (et 1 colonne)
tabfinal(1, 1) = "Lieu définitif" 'on met le titre de la colonne dans le tablo
For i = LBound(tabdata, 1) + 1 To UBound(tabdata, 1) 'pour chaque ligne du tablo de la feuille 1
ligne = tabdata(i, 1) 'on récupère la ligne base action
DateValid = tabdata(i, 6) 'la date
For j = 11 To UBound(tabdata, 2) 'on cherche quel lieu sera à mettre ==> il est identifié par un "OK" sur la ligne
If tabdata(i, j) = "OK" Then
LieuFin = tabdata(1, j)
Exit For 'pas la peine de continuer la boucle
End If
Next j
tabfinal(ligne, 1) = tabfinal(ligne, 1) & " " & DateValid & " - " & LieuFin 'on met dans le tablo final les infos à la bonne ligne
Next i
Sheets("Feuil2").Range("Z1").Resize(UBound(tabfinal, 1), UBound(tabfinal, 2)) = tabfinal 'on colle le tablo final dans la feuille 2
End Sub