Positionnement alterné sur ligne paire et impaire

Option Explicit

Private Sub specpi()
Dim sho As Worksheet, shn As Worksheet
Dim lcur As Long, nextD As Long, nextO As Long
Set sho = ThisWorkbook.Sheets("speco")
Set shn = ThisWorkbook.Sheets("specn")
lcur = 2
nextD = getnext(sho, 1, True)
nextO = getnext(sho, 1, False)
Do While nextD <> 0 Or nextO <> 0
    If nextD = 0 Then
        sho.Rows(nextO).Copy shn.Rows(lcur)
        nextO = getnext(sho, nextO, False)
    Else
        If nextO = 0 Then
            sho.Rows(nextD).Copy shn.Rows(lcur)
            nextD = getnext(sho, nextD, True)
        Else
            If lcur Mod 2 = 0 Then
                sho.Rows(nextO).Copy shn.Rows(lcur)
                nextO = getnext(sho, nextO, False)
            Else
                sho.Rows(nextD).Copy shn.Rows(lcur)
                nextD = getnext(sho, nextD, True)
            End If
        End If
    End If
    lcur = lcur + 1
Loop
End Sub
Private Function getnext(sh As Worksheet, lig As Long, D As Boolean) As Long
getnext = lig + 1
Do While (sh.Cells(getnext, 1) <> "") And (InStr(sh.Cells(getnext, 2), "D") > 0) <> D
    getnext = getnext + 1
Loop
If sh.Cells(getnext, 1) = "" Then
    getnext = 0
End If
End Function