VBA copier collé conditionnel

Bonjour, premier message sur ce forum.

Je vous résume ma situation en espérant être assez clair (faisant cet Excell pendant un stage je doute de pouvoir mettre ce genre de doc en ligne j'en suis désolé).

Pour résumer mon classeur excell comporte 2 tableaux sur 2 feuilles séparées On va les appeler Tableau 1 et Tableau 2.

J'aimerai savoir comment je pourrais ,via VBA, copier une colonne précise du tableau 2 dans le tableau 1 ( en remplacement des données qui y sont déjà) tout en évitant les doublons le tout avec une condition

Pour résumer dans le tableau 2 il y a la colonne C qui contient des noms d'articles et la colonne F les références clients.
Le tableau 1 lui ne contient qu'une colonne A "Nom d'articles". J'aimerai pouvoir copier depuis le tableau 2 vers le 1 tous les nom d'articles qui possèdent aussi une réf client tout en évitant de me retrouver avec plusieurs fois le même nom d'article (en ne prenant en compte que la première ref client valide)
par exemple si on est à la ligne 15 et que le nom d'article dans le tableau 2 c'est RTH5 et que la ligne 15 a aussi une ref client je veux que RTH5 apparaisse dans le tableau 1. Mais si la ligne 16 c’est également RTH5 mais avec une autre ref client je voudrais que le programme l'ignore.

Voila je ne sais pas si c'était très clair je suis à disposition pour plus de précision. Sachant que je ne demande pas forcement un programme déjà écrit, piste sera déjà très bien.
Merci d'avance

Bonjour

un peu difficile à comprendre comme ça, tu peut nous refaire un fichier semblable mais avec des données bidons ?

Sinon surement un "=si(tableau2cellule1 = tableau2cellule2;"";recherchev(tableau1cellule1;tableau2;2;faux)

Bonne idée je vais refaire un tableau bidon. Comme tu vois le tableau 2 est déjà remplis mais il faut le mettre à jour car certain articles n'ont plus de ref dans le tableau 1 j'espère que c'est un peu plus clair. Sachant que même si on a deux lignes avec la même ref client il ne faudrait prendre QUE la première itération du nom d'article

3question.xlsx (9.86 Ko)

bien,

normalement un simple recherchev devrait suffire si j'ai bien compris, à voir si cela fonctionne dans ton fichier de base:

4question.xlsx (11.00 Ko)

Oui donc je n'étais pas très clair, comme tu vois avec ta méthode tu ramenes la ref client sur le tableau 2 alors que ce n'est pas ce que je veux. En fait le tableau 2 après la macro ne devrait plus contenir que les nom d'article qui ont une ref client dans le tableau 1. Par exxemple T devrait apparaitre et Q disparaitre.

ok, passage par macro je suis arrivé à un truc pas trop mal

il faut que tu adapte le nom des feuilles ( les sheets("tableau X") en rouge, éventuellement les colonnes aussi en rouge)

Sub test()
Sheets("tableau 2").Select
Range("A1:B100").Select
Selection.Clear
Sheets("tableau 1").Select
Dim var As Long
For var = 1 To Cells(Rows.Count, "B").End(xlUp).Row
Sheets("tableau 1").Select
If Cells(var, 2) <> "" Then
Rows(var).Select
Selection.Copy
Sheets("Tableau 2").Select
Rows(var).Select
ActiveSheet.Paste

End If
Next var
Dim ve As Long
For ve = 1 To Cells(Rows.Count, "B").End(xlUp).Row
Sheets("tableau 2").Select
If Cells(ve + 1, 1) = Cells(ve, 1) Then
Rows(ve).Select
Selection.Delete
End If
Next ve

Dim re As Long
For re = 1 To Cells(Rows.Count, "B").End(xlUp).Row
Sheets("tableau 2").Select
If Sheets("tableau 2").Cells(re, 2) = "" Then
Rows(re).Select
Selection.Delete
End If
Next re
End Sub

tu peux faire un essai avec le fichier que tu m'a envoyer si c'est bien ça que tu veux:

Alors j'ai essayé de l'intégrer et ça a bien supprimé la ligne A donc la première mais ça c'est arreté juste après. Rien d'autre n'a été supprimé ni ajouté. J'ai utilisé le tableau question pour ne pas avoir à adapter au début. Tu obtiens quoi comme résultat toi ?

Sub maj()

Dim j As Integer

Dim ref_actuel As String

Dim i As Variant

i = 2

j = 4

While i < 1500

ref_actuel = Sheets("Tableau").Range("F" & i)

If (Sheets("Tableau").Range("F" & i) = " ") Then

i = i + 1

j = j

Else

If (ref_actuel = Sheets("Tableau").Range("F" & i)) Then

i = i + 1

Else

Sheets("Code-barre_Clients Principaux").Range("A" & j) = Sheets("Tableau").Range("C" & i)

i = i + 1

j = j + 1

End If

End If

Wend

End Sub

j'ai fait quelque chose dans ce genre ça ne fait littéralement rien

edit: j'ai essayé un nouveau code mais finalement il ne fonctionne pas non plus, je continue a travaillé dessus.

Si tu te met bien sur la première feuille (tableau 1) le code devrait fonctionner

Re-edit: voici un nouveau code corriger qui devrait aller dans tout les cas (je l'espère):

Sub Bouton1_Cliquer()
With Worksheets("tableau 1")
.Activate
Dim var As Integer
For var = 1 To Cells(Rows.Count, "B").End(xlUp).Row
If .Cells(var, 2) <> " " Then
.Rows(var).Select
Selection.Copy
Worksheets("Tableau 2").Select
Worksheets("tableau 2").Rows(var).Select
ActiveSheet.Paste
End If
Worksheets("tableau 1").Activate
Next var
End With

Dim abc As Integer
For abc = 1 To Cells(Rows.Count, "B").End(xlUp).Row
With Worksheets("tableau 2")
.Activate
If .Cells(abc + 1, 1) = .Cells(abc, 1) Then
.Rows(abc).Select
Selection.Delete
End If
End With
Next abc

Dim re As Integer
For re = 1 To Cells(Rows.Count, "B").End(xlUp).Row
With Worksheets("tableau 2")
.Activate
If .Cells(re, 2) = "" Then
.Rows(re).Select
Selection.Delete
End If
End With
Next re

End Sub

Bon j'ai mis du temps mais la voilà un peu moins dégeu :

Sub Bouton1_Cliquer()
With Worksheets("tableau 1")
.Activate
Dim var As Integer
For var = 1 To Cells(Rows.Count, "B").End(xlUp).Row
If .Cells(var, "B") <> "" Then
.Rows(var).Select
Selection.Copy
Worksheets("Tableau 2").Select
Worksheets("tableau 2").Rows(var).Select
ActiveSheet.Paste
End If
Worksheets("tableau 1").Activate
Next var
End With

Dim abc As Integer
With Worksheets("tableau 2")
.Activate
For abc = 1 To Cells(Rows.Count, "B").End(xlUp).Row
If .Cells(abc + 1, 1) = .Cells(abc, 1) And .Cells(abc, 1) <> "" Then
.Rows(abc).Select
Selection.Delete
abc = abc - 1
Else
End If
Next
End With

Dim l As Long
For l = Cells(65356, 1).End(xlUp).Row To 1 Step -1
If Cells(l, 1).Value = "" Then Cells(l, 1).EntireRow.Delete
Next l

End Sub

Mais il y a certainement bien plus simple ...

Rechercher des sujets similaires à "vba copier colle conditionnel"