Sub Test_DoubleLignesColonne()
Call DoubleLignesColonne(ActiveSheet, 5, "PLVT 03/2022 FACTURE CTR ")
End Sub
Sub DoubleLignesColonne(Wsh As Worksheet, NoColonne As Integer, AjoutChaine As String)
Dim Tab1() As Variant
Dim Tab2() As Variant
Dim NbLignes As Long
Dim i As Long
Const NbLignesTitre = 0
With Wsh
'Défiltrer pour ne pas fausser le xlUp avec des lignes de fin filtrées
If Not .AutoFilter Is Nothing Then .AutoFilter.ShowAllData
NbLignes = .Cells(Rows.Count, NoColonne).End(xlUp).Row
Tab1 = .Cells(NbLignesTitre + 1, NoColonne).Resize(NbLignes - NbLignesTitre).Value
ReDim Tab2(1 To UBound(Tab1, 1) * 2, 1 To 2)
For i = 1 To UBound(Tab1, 1)
Tab2(i * 2 - 1, 1) = Tab1(i, 1)
Tab2(i * 2, 1) = Tab1(i, 1)
Tab2(i * 2 - 1, 2) = AjoutChaine & Tab1(i, 1)
Tab2(i * 2, 2) = AjoutChaine & Tab1(i, 1)
Next i
.Cells(NbLignesTitre + 1, NoColonne).Resize(UBound(Tab2, 1), UBound(Tab2, 2)).Value = Tab2
End With
End Sub