Copier - Coller une ligne sur deux

Bonjour à tous,

Je suis à la recherche d'une macro me permettant de copier les données d'une colonne et de les coller dans une autre colonne une ligne sur deux et dédoubler les valeurs (pas obligatoire de dédoubler les valeurs ça serait top mais je peux faire sans)

Voici le détails,

Donnée à copier : feuille : "Data_Employé" ; colonne : E2 to End

A coller : feuille : "Planning" ; colonne : B6 to End // Une ligne sur deux

Exemple :

En colonne E de la feuille Data_Employé :

E2 : Test1

E3 : Test2

E4 : Test 3

Résultat voulu en feuille planning :

B6 : Test1

B7 : Test1

B8 : Test2

B9 : Test2

B10:Test3

B11 : Test3

ou alors :

B6 : Test1

B7 : Rien

B8 : Test2

B9 : Rien

B10 : Test3

B11 : rien

Voilà ce que j'ai tenter sans résultat :

Private Sub CopieColle()

For i = 2 To Sheets("Data_Employé").Range("E2:E" & [E65536].End(xlUp).Row)

For j = i + 4 To Sheets("Data_Employé").Range("E2:E" & [E65536].End(x1Up).Row) + 4 Step 2

Sheets(Data_Employé).Range("E" & i) = Sheets("Planning").Range("B" & j)

Next j

Next i

End Sub

J'aimerais également que la macro masque une ligne sur deux dans la colonne des résultat en feuille Planning :

B6 : Masqué

B7 : Test1

B8 : Masqué

B9 : Test2

B10 : Masqué

B 11 : Test3

Et j'aimerais également créer une autre macro permettant de rendre visible toute les lignes (afin que lors d'une nouvelle exécution de la macro précédente, toute les lignes soit visibles sinon j'ai peur que toutes les lignes ce masque si deux exécution !!). Mais ça je peux le trouver tt seul avec l'enregistreur de macro

Merci d'avance

Salut,

Tu peux essayer ca.

Sub CopieEtMasque()

Dim LastLigneData As Integer, LastLignePlanning As Integer

LastLigneData = Sheets("Data_Employé").Range("B65000").End(xlUp).Row
'Copie les infos
p = 4
Sheets("Planning").Select
For i = 2 To LastLigne
    p = p + 2
    Sheets("Planning").Cells(p, 2).Value = Sheets("Data_Employé").Cells(i, 2).Value
    Sheets("Planning").Cells(p + 1, 2).Value = Sheets("Data_Employé").Cells(i, 2).Value
Next i

'Masque les lignes
LastLignePlanning = Sheets("Planning").Range("B65000").End(xlUp).Row
For i = 6 To LastLignePlanning Step 2
        Cells(i, 3).EntireRow.Hidden = True
Next i
End Sub

Sub Affiche()

Cells.Select
Selection.EntireRow.Hidden = False
End Sub

C'est parfait un grand merci

Il y avais quelques petites erreurs mais j'ai réussis à l'adapter à mon problème

Voici la solution final :

Sub CopieEtMasque()

Dim LastLigneData As Integer, LastLignePlanning As Integer

LastLigneData = Sheets("Data_Employé").Range("E65000").End(xlUp).Row
'Copie les infos
p = 4
Sheets("Planning").Select
For i = 2 To LastLigneData
    p = p + 2
    Sheets("Planning").Cells(p, 2).Value = Sheets("Data_Employé").Cells(i, 5).Value
    Sheets("Planning").Cells(p + 1, 2).Value = Sheets("Data_Employé").Cells(i, 5).Value
Next i

'Masque les lignes
LastLignePlanning = Sheets("Planning").Range("B65000").End(xlUp).Row
For i = 6 To LastLignePlanning Step 2
        Cells(i, 3).EntireRow.Hidden = True
Next i
End Sub

Encore merci

Oui effectivement,

Comme quoi quand on veut aller trop vite