Ajouter les valeurs non existantes

J'ai ouiblié de mettre le code qui ne marchait pas :


Sub CopiePrd()
Set mondico = CreateObject("Scripting.Dictionary")

'-------- lecture anciens
Set f = Sheets("Prd")
If [F2] <> "" Then
For Each c In f.Range("F2", f.[F65000].End(xlUp))
mondico.Add c.Value, ""
Next c
End If
'-------------------------
'------- ajout nouveaux
Set f = Sheets("Prd")
MsgBox "derniere ligne dans Prd Col A : " & f.
[A65000].End(xlUp).Row
For Each c In f.Range("A2", f.[A65000].End(xlUp))
If Not mondico.Exists(c.Value) Then
MsgBox "Prd nouv : " & c.Value
mondico.Add c.Value, ""
End If
Next c


'----------- faire une copie dans Colonne F ----
[F2].Resize(mondico.Count, 1) =
Application.Transpose(mondico.keys)
[G2].Resize(mondico.Count, 1) =
Application.Transpose(mondico.items)
Range("F2", [F65000].End(xlUp)).Sort Key1:=Range("F2"),
Order1:=xlAscending, Header:=xlGuess
Set mondico = Nothing

End Sub

---------------

Merci.

Salut à toi
Soit La Feuil1 à traiter
Colonne A la source
Colonne B à compléter
Je te propose ce code :

For Each c In Worksheets("Feuil1").Range("A2", "A" &
Range("A65535").End(xlUp).Row)
Range("B1").Activate
On Error Resume Next
Range("B1", "B" & Range("B65535").End(xlUp).Row).Find(What:=c,
After:=Range("B1"), LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
If ActiveCell.Address = Range("B1").Address Then
Range("B65535").End(xlUp).Offset(1, 0) = c
End If
Next

Celà devrait convenir

Dis moi !!!!

Bonjour,

J'aimerais ajouter dans F tout les valeurs de la colonne A non existantes
dans F.

Ceci peut-être..
'--------
Sub jj()
For Each c In Range("A1:a" & [a65536].End(3).Row)
If Application.CountIf(Range("F:F"), c) = 0 Then Range("f" &
[f65536].End(3).Row + 1) = c
Next
End Sub
'----------

--
Salutations
JJ


"Apitos" <apitos@gmail.com> a écrit dans le message de news:
9b8b03dc-4e79-440e-aeb7-c14d2380412a@d1g2000hsg.googlegroups.com...
J'ai ouiblié de mettre le code qui ne marchait pas :


Sub CopiePrd()
Set mondico = CreateObject("Scripting.Dictionary")

'-------- lecture anciens
Set f = Sheets("Prd")
If [F2] <> "" Then
For Each c In f.Range("F2", f.[F65000].End(xlUp))
mondico.Add c.Value, ""
Next c
End If
'-------------------------
'------- ajout nouveaux
Set f = Sheets("Prd")
MsgBox "derniere ligne dans Prd Col A : " & f.
[A65000].End(xlUp).Row
For Each c In f.Range("A2", f.[A65000].End(xlUp))
If Not mondico.Exists(c.Value) Then
MsgBox "Prd nouv : " & c.Value
mondico.Add c.Value, ""
End If
Next c


'----------- faire une copie dans Colonne F ----
[F2].Resize(mondico.Count, 1) Application.Transpose(mondico.keys)
[G2].Resize(mondico.Count, 1) Application.Transpose(mondico.items)
Range("F2", [F65000].End(xlUp)).Sort Key1:=Range("F2"),
Order1:=xlAscending, Header:=xlGuess
Set mondico = Nothing

End Sub

---------------

Merci.

Merci François et Jacky.

Je crois que je vais prendre le code de Jacky (il est plus léger!).

Bon pour le même code, mais cette fois-ci j'aimerais faire une mise à
jour des colonnes F & G depuis les colonnes A & B.

Les en-tetes sont : Catégorie (A-F) --- Abréviation (B-G).

Merci.

Rebonjour à toi

J'ai beaucoup de mal à comprendre ta 2° demande
Peux tu être plus explicite

Merci

Voilà un petit exemple :

http://cjoint.com/?eDschAWZz8

Re..
Essaie ceci
'-------------
Sub CopieCat()
'-------- Completer la colonne F et G depuis la colonne A et B
For Each c In Range("A2:A" & [A65536].End(3).Row)
If Application.CountIf(Range("F:F"), c) = 0 Then
Range("F" & [F65536].End(3).Row + 1) = c
Range("g" & [F65536].End(3).Row) = c.Offset(0, 1)
End If
Next

'---- Tri
Range("F2", [G65000].End(xlUp)).Sort Key1:=Range("F2"),
Order1:=xlAscending, Header:=xlGuess
End Sub
'------------------

--
Salutations
JJ


"Apitos" <apitos@gmail.com> a écrit dans le message de news:
5ab5a45e-ab26-4896-96f5-9b43f110d4fe@c58g2000hsc.googlegroups.com...
Voilà un petit exemple :

http://cjoint.com/?eDschAWZz8

Bonsoir,

Merci Jacky.

Ca marche.