XL 2019 Copie cellule d'une feuille à l'autre

[chinel]

Bonjour j'ai une macro pour copier des données d'une cellule vers une autre feuille mais je désire ne pas avoir de doublon. Besoin d'aide, merci

Sub ajouteràlaliste()
Dim Valeur As String
Valeur = Range("B4").Value
With Sheets("Personnel")
If .Range("A4") = "" Then
.Range("A4").Value = Valeur
Else
.Range("A65536").End(xlUp).Offset(1, 0).Value = Valeur
End If
End With
End Sub

ce code c'est juste pour copier la cellule B4 de la feuille "Planning" vers la feuille "Personnel" en A4 mais si je veux prendre la cellule C4 de la feuille "Planning" vers la feuille "Personnel" en B4, comment faire ?

 

[Phil69970]

Bonjour @chinel

Je te propose

Sub ajouteràlaliste()
Dim Valeur As String, Derlig&
Valeur = Range("B4").Value
With Sheets("Personnel")
    If .Range("A4") = "" Then
        .Range("A4").Value = Valeur
    Else
        .Range("A65536").End(xlUp).Offset(1, 0).Value = Valeur
    End If
    Derlig = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A4:A" & Derlig).RemoveDuplicates Columns:=1, Header:=xlNo
End With
End Sub

Merci de ton retour

@Phil69970

 

[chinel]

Bonjour @chinel

Je te propose

Sub ajouteràlaliste()
Dim Valeur As String, Derlig&
Valeur = Range("B4").Value
With Sheets("Personnel")
    If .Range("A4") = "" Then
        .Range("A4").Value = Valeur
    Else
        .Range("A65536").End(xlUp).Offset(1, 0).Value = Valeur
    End If
    Derlig = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A4:A" & Derlig).RemoveDuplicates Columns:=1, Header:=xlNo
End With
End Sub

Merci de ton retour

@Phil69970

Je regarde tantôt car ici je bosse merci encore pour ton soutien !

 

[chinel]

Bonjour @chinel

Je te propose

Sub ajouteràlaliste()
Dim Valeur As String, Derlig&
Valeur = Range("B4").Value
With Sheets("Personnel")
    If .Range("A4") = "" Then
        .Range("A4").Value = Valeur
    Else
        .Range("A65536").End(xlUp).Offset(1, 0).Value = Valeur
    End If
    Derlig = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A4:A" & Derlig).RemoveDuplicates Columns:=1, Header:=xlNo
End With
End Sub

Merci de ton retour

@Phil69970

Merci beaucoup pour cette solution ! Mais ce code c'est juste pour copier la cellule B4 de la feuille "Planning" vers la feuille "Personnel" en A4 mais si je veux en plus prendre la cellule C4 de la feuille "Planning" vers la feuille "Personnel" en B4, comment faire ?

 

[Phil69970]

Re

La demande initial a été modifié .......

Voici le nouveau de ce que j'en ai compris avec néanmoins une incertitude sur la copie de C4 ????
==> Voir les commentaire dans le code
==> J'ai choisi dans tous les cas la copie de C4 se fait ! (Sinon inverser les 2 lignes de commentaires)

Sub ajouteràlaliste()
Dim Derlig&
With Sheets("Personnel")
    Derlig = .Range("A" & Rows.Count).End(xlUp).Row + 1
    If .Range("A4") = "" Then
        .Range("A4").Value = Sheets("Planning").Range("B4").Value
        ' ??? Pas tres claire la nouvelle demande si on copie C4 uniquement ici ou dans tous les cas ????
        '.Range("B4").Value = Sheets("Planning").Range("C4").Value
    Else
        .Range("A" & Derlig).Value = Sheets("Planning").Range("B4").Value
    End If
    ' ??? Pas tres claire la nouvelle demande si on copie C4 dans tous les cas ????
    .Range("B4").Value = Sheets("Planning").Range("C4").Value
    
    .Range("A4:A" & Derlig).RemoveDuplicates Columns:=1, Header:=xlNo
End With
End Sub

Merci de ton retour

@Phil69970

 

[chinel]

Bonjour, voici mon fichier plus facile pour expliquer

 

[Phil69970]

Re

1) Bruno à raison pour le titre, édite le et modifie le.
Tu pourrais mettre :
Copie cellule d'une feuille à l'autre

2) Un peu (beaucoup) de rigueur serait le bienvenu dans tes demandes

ce code c'est juste pour copier la cellule B4 de la feuille "Planning" vers la feuille "Personnel" en A4 mais si je veux prendre la cellule C4 de la feuille "Planning" vers la feuille "Personnel" en B4, comment faire ?

Et dans ton fichier je vois ceci !!!

Le code qui réponds a ta demande comme demandée dans TON fichier

Sub ajouteràlaliste()
Dim Derlig&
With Sheets("Personnel")
    Derlig = .Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("A" & Derlig).Value = Sheets("Planning").Range("B4").Value
    .Range("B" & Derlig).Value = Sheets("Planning").Range("B5").Value
    .Range("A3:B" & Derlig).RemoveDuplicates Columns:=1, Header:=xlNo
End With
End Sub

Si au 1er post tu avait mis TON fichier on aurait gagné 6 messages et tu aurais gagné 24 H 00 !

Perso je ne comprends pas trop la finalité de ton fichier et ce que tu cherches à faire mais j'ai répondu à ta question

@Phil69970