Probleme Condition: Verification d'une cellule par rapport une colonne

Bonjour,

Je voudrais bien que vous m'aidez a réaliser mon programme car la je suis bloqué et je sature a force de chercher . Il faut savoir que je suis nouveau dans ce monde de Visual Basic sous excel.

Voici ce que je voudrais faire (Pseudo-Code) [Screenshot après si vous n'avez pas compris mes explications :) ]

Si CelluleA(Valeur qui sera N+1 a chaque tour de la boucle) de la feuilleA = ColonneA de la feuilleB Alors

Copier la celluleB de la feuilleA dans la feuilleB a la celluleC a coté des valeurs identique

Sinon

Copier la celluleA de la feuilleA dans la feuilleB a la suite des cellulesA de la feuilleB

Copier la celluleB de la feuilleA dans la feuilleB a la celluleC a coté des valeurs crée de la feuilleB

Fin si

Voici ce que j'ai fais pour l'instant (Spoiler ça marche pas)

Sub test()
Range("C1").Select

    ' variable pour la boucle
    Dim cellulue As Range
    cellule = 1

    For Each cellule In Range("A1:A500")
    NbLigne = NbLigne + 1
        If (Sheets("User2").Range("A" & CStr(NbLigne)) = Sheets("Final").Range("A1").Offset(1, 3)) Then
            Sheets("User2").Range("B" & CStr(NbLigne)).Copy Destination:=Sheets("Final").Range("C1").Offset(1, 3)
            Selection.Offset(1, 0).Select
        Else
            Sheets("User2").Range("A" & CStr(NbLigne)).Copy Destination:=Sheets("Final").Range("A1:A").Cells(Rows.Count, 1).End(xlUp).Row
            Sheets("User2").Range("B" & CStr(NbLigne)).Copy Destination:=Sheets("Final").Range("C1:C").Cells(Rows.Count, 1).End(xlUp).Row
        End If

    Next

End Sub

(ce sont des prénoms générique et téléphone inclus)

Prénom/Tel2 en bleu = ce sont des prénoms qui ne sont pas dans la feuilleB donc on les ajoutes dans la feuille B

Tel2 en rouge Lié au prénom vert= Les prénoms existe alors on les mets a la suite des prénoms déjà existant dans la colonne tel2

Voila Merci beaucoup de lire par avance :D
(Si vous avez une question ou si il y a ambiguïté pas de soucis je répondrais également :D)
Cordialement un débutant :D .

Update: j'ai rajouté le doc avec les macros :)

bonjour,

pourrais-tu mettre ton fichier (exemple représentatif) plutôt qu'une image ?

Bonjour,

Déjà merci de ta réponse je fais ça rapidement (je dois modifier quelques valeurs :D)

Feuille1: User1

Feuille2:User2

Feuille3: Final c'est la fusion des deux feuilles puis les macros sont dedans.

bonjour,

une proposition à adapter

Sub aargh()
    Set wss = Sheets.Add
    wss.Name = "Synthèse"
    With Sheets("User1") 'copie données feuil1 dans synthèse
        dl1 = .Cells(Rows.CountLarge, 1).End(xlUp).Row
        .Range("A1").Resize(dl1, 2).Copy wss.Range("A1")
        dl = wss.Cells(Rows.CountLarge, 1).End(xlUp).Row
    End With
    With Sheets("user2") 'copie données feuil2 dans synthèse
        dl1 = .Cells(Rows.CountLarge, 1).End(xlUp).Row
        .Range("A1").Resize(dl1, 2).Copy wss.Cells(dl + 1, 1)
    End With
    With wss
        dl1 = .Cells(Rows.CountLarge, 1).End(xlUp).Row
        .Range("A1").Resize(dl1, 2).Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlNo 'tri des données
        For i = dl1 To 2 Step -1
            If .Cells(i - 1, 1) = .Cells(i, 1) Then 'fusion de lignes
                .Cells(i - 1, 3) = .Cells(i, 2)
                .Rows(i).Delete 'suppression de ligne
            End If
        Next i
    End With
End Sub

Alors merci beaucoup !

Je vais juste t’embêter encore une fois après j’arrête (je suis vraiment désolé je vraiment novice dans le Vb )

j'arrive pas a trouver a forcer a laisser une case vide

Exemple si Arthur a un Tel2 mais pas un Tel1 alors on laisse la case Tel1 vide mais on rempli la case Tel2 :)

En ce moment

Ce que j'aimerais x)

j'ai essayé de modifier ton code pour comprendre mais j'arrive pas a trouver la ligne :/ si c'est possible que tu rajoutes un peu plus de commentaire pour ma connaissance

Et encore je t'en remercie énormément pour ce que tu as fait :)

Bonjour,

je n'ai pas compris qu'il fallait garder la différence entre tel1 et tel2.

Le code fourni ne convient pas, il faut une autre approche que voici (ne fonctionne pas sur mac)

Sub aargh()
    Dim t
    Set dict = CreateObject("scripting.dictionary")
    Set ws1 = Sheets("user1")
    dl1 = ws1.Cells(Rows.CountLarge, 1).End(xlUp).Row
    Set ws2 = Sheets("user2")
    dl2 = ws2.Cells(Rows.CountLarge, 1).End(xlUp).Row
    ReDim t(1 To dl1 + dl2, 1 To 3)
    For j = 1 To 2
        If j = 1 Then Set ws = ws1: dl = dl1 Else Set ws = ws2: dl = dl2
        For i = 1 To dl
            nom = ws.Cells(i, 1)
            If dict.exists(nom) Then
                Index = dict(nom)
            Else
                k = k + 1
                dict(nom) = k
                t(k, 1) = nom
                Index = k
            End If
            t(k, j + 1) = ws.Cells(i, 2)
        Next i
    Next j
    Sheets("final").Range("A1").Resize(k, 3) = t
End Sub

Alors merci beaucoup de ta réponse mais j'ai réussi de mon coté a d'adapter ta première macro d'hier soir mais t'as façon de faire doit être plus propre que la mienne :D

J'ai refais une macro "Déplacement"(bon c'est pas ouf mais ça marche et j'en suis content )

Sub deplacement()

Dim Dl As Long
Dl = Cells(Application.Rows.Count, 1).End(xlUp).Row

For i = 1 To Dl
    NbLigne = NbLigne + 1
    If Sheets("Synthèse").Range("B" & CStr(NbLigne)).Value > 9999 Then
        Sheets("Synthèse").Cells(NbLigne, 3) = Sheets("Synthèse").Cells(NbLigne, 2)
        Sheets("Synthèse").Cells(NbLigne, 2) = "Pas de numero"
    End If

    NbLigne2 = NbLigne2 + 1
    If Sheets("Synthèse").Range("C" & CStr(NbLigne2)).Value = "" Then
        Sheets("Synthèse").Cells(NbLigne2, 3) = "Pas de numero"
    End If
Next
End Sub