Recopiage de donnée dans une ligne sans doublon. VBA

  • Initiateur de la discussion Initiateur de la discussion Bert
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Bert

XLDnaute Nouveau
Bonjour à tous,

J'espère que ma question trouvera réponse grâce à vous.
Je dispose d'une liste client dans une feuille de calcul.
Grace à une macro j'aimerai pour la colonne "site de prélèvement" envoyer les données dans la feuille de calcul "site" en fonction de chaque client en ligne. Et ce sans créer des doublons.

Voici le code que j'ai tapé:
Quand j’exécute j'ai une erreur de compilation 424 "Objet requis".
Je ne parviens pas à voir les erreurs dans le code.

Merci d'avance si vous me donnez vos idées ou si vous trouvez la solution!

Code:
Sub Site()

Dim i, c, j As Integer
Dim a, b As String

i = Worksheets("Echantillons").Range("A2").Row
' i : Ligne de la première cellule dans ech à vérifier
a = Worksheets("Echantillons").Cells(i, 1).Value 
' Valeur du client dans ech
b = Worksheets("Echantillons").Cells(i, 5).Value
 ' Valeur du site dans ech
c = Application.VLookup(a, Worksheets("Site").Range("A2:A100000"), 1, False).Row
' Numéro de la ligne dans worksheets site de la valeur du site

Do While a <> ""
' tant qu'il reste des client dans la liste de la feuille echantillon
j = 2
Do While Cells(c, j) <> ""
'Tant que la cellule dans la feuille site est différent de rien
If Cells(c, j).Value = b Then GoTo FIN1 'si il trouve la valeur, on écrit pas le doublon
If Cells(c, j).Value = "" Then 'si il ne trouve pas la valeur il l'écrit dans la ligne à la suite
Cells(c, j).Value = b
GoTo FIN1
End If
j = j + 1 ' il continue de chercher dans la ligne
Loop

FIN1:

i = i + 1 ' il procède ainsi pour toutes les ligne de la feuille  Echantillon
Loop

End Sub
 

Pièces jointes

Re : Recopiage de donnée dans une ligne sans doublon. VBA

bonjour Bert
bienvenue
un code qui fonctionne
si tu as unne erreur avec c= Application.Match(a, Rng, 0)
mettre des données correctes dans échantillons

Code:
Sub Site()

Dim i As Long, b As Variant, c As Long, j As Long
Dim a As String, Rng As Range
Set Rng = Worksheets("Site").Range("A1:A" & Worksheets("Site").Range("A65536").End(xlUp).Row)
With Worksheets("Echantillons")
For i = 2 To .Range("A65536").End(xlUp).Row
'i = .Range("A2").Row
' i : Ligne de la première cellule dans ech à vérifier
a = .Cells(i, 1).Value ' Valeur du client dans ech
b = .Cells(i, 5).Value ' Valeur du site dans ech
'c = Application.VLookup(a, Worksheets("Site").Range("A2:A100000"), 1, False).Row
c = Application.Match(a, Rng, 0) '.Row
' Numéro de la ligne dans worksheets site de la valeur du site
 If c > 0 And Worksheets("Site").Cells(c, b + 1).Value = "" Then
'    MsgBox "Aucune occurence trouvée de " & c & " ...", , Titre
'    Exit Sub
'    Else
Worksheets("Site").Cells(c, b + 1).Value = .Cells(i, 6).Value  'inscrit prélèvement
  Else
  c = Worksheets("Site").Range("A65536").End(xlUp).Row + 1
  Worksheets("Site").Cells(c, 1) = a
  Worksheets("Site").Cells(c, b + 1) = .Cells(c, 6)
  End If
  Next i
  End With
'Do While a <> ""
'' tant qu'il reste des client dans la liste de la feuille echantillon
'j = 2
'Do While Worksheets("Site").Cells(c, j) <> ""
''Tant que la cellule dans la feuille site est différent de rien
'If Worksheets("Site").Cells(c, j).Value = b Then GoTo FIN1 'si il rouve la valeur, on écrit pas la doublon
'If Worksheets("Site").Cells(c, j).Value = "" Then 'si il ne trouve pas la valeur il l'écrit dans la ligne à la suite
'Worksheets("Site").Cells(c, j).Value = b
'GoTo FIN1
'End If
'j = j + 1 ' il continue de chercher dans la ligne
'Loop
'
'FIN1:
'
'i = i + 1 ' il procède ainsi pour toutes les ligne de la feuille  Echantillon
'Loop

End Sub
 
Re : Recopiage de donnée dans une ligne sans doublon. VBA

Bonjour Bert,

J'ai regardé un peu ton fichier, mais je ne trouve pas la feuille "LISTE" et "PDF" ?
Si tu pouvais vérifier et nous faire parvenir la mouture avec ces deux feuilles manquantes, nous pourrions mieux suivre l'évolution de ton programme .

A te relire

René

EDIT: Salut Bebere
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
45
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
482
Réponses
3
Affichages
485
Retour