Sub dupliqueCA()
Dim tablo()
With Sheets("Feuil2")
titres = Array("civilite", "nom", "nom de jeune fille", "prenom", "date naissance", "CA")
For lig = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
For col = 1 To 2
If .Cells(lig, 5 + col) <> "" Then
ReDim Preserve tablo(5, i)
tablo(0, i) = .Cells(lig, 1)
tablo(1, i) = .Cells(lig, 2)
tablo(2, i) = .Cells(lig, 3)
tablo(3, i) = .Cells(lig, 4)
tablo(4, i) = .Cells(lig, 5)
tablo(5, i) = .Cells(lig, 5 + col)
i = i + 1
End If
Next col
Next lig
.[A:G].EntireColumn.ClearContents
.[A1:F1] = titres
.[A2].Resize(i, 6) = Application.Transpose(tablo)
End With
End Sub: