Recopier une cellule sur 2

Bonjour

Tout est dans le titre et le fichier ci-joint

Merci pour votre aide

J'ai trouvé avec ces formules

=INDIRECT("C"&((LIGNES($1:1)-2)*2+2)+3)

=INDIRECT("C"&((LIGNES($1:1)-2)*2+2)+4)

Bonjour,

A tester :

Sub TestCelluleDestination()

    UneCelluleSurDeux Range("C3:C8"), Range("F3")
    UneCelluleSurDeux Range("C4:C8"), Range("H3")

End Sub

Sub UneCelluleSurDeux(ByVal AireATraiter As Range, ByVal CelluleDestination As Range)

Dim I As Integer, LigneDestination As Integer

    LigneDestination = 0

    For I = 1 To AireATraiter.Count Step 2
        CelluleDestination.Offset(LigneDestination, 0) = AireATraiter(I)
        LigneDestination = LigneDestination + 1
    Next I

End Sub