Salut le forum
Pat, ta maco à lancer depuis la feuille 18109 et modifie tes noms
en colonne A pour avoir les mêmes noms que tes feuilles. (supprime l'espace)
Sub Extraction()
Dim O_Sheet As Object
Dim Ligne As Byte, I As Byte
Set O_Sheet = ActiveSheet
For Ligne = 7 To 29 Step 2
With Sheets(O_Sheet.Cells(Ligne, 1).Value)
.Range("A2").End(xlDown).Offset(1, 0).EntireRow.Insert
With .Range("A2").End(xlDown)
.Offset(1, 0) = O_Sheet.Cells(3, 1)
For I = 2 To 6
If Not IsEmpty(O_Sheet.Cells(Ligne, I)) Then
.Offset(1, O_Sheet.Cells(Ligne, I)) = O_Sheet.Cells(4, I)
End If
Next I
End With
End With
Next Ligne
Set O_Sheet = Nothing
End Sub
Mytå