Code VBA qui ne copie pas a partir de la bonne cellule

Bonjour

J'ai un petit soucis avec ce code au lieu de copier a partir de B3 il copie a partir de B2 B2 étant une entête elle ne doit pas être copier car les entêtes sont recopier

dans la feuille Inscriptions

Sub CopieSansDoublons()
  Dim myRng As Range
  Set myRng = ThisWorkbook.Worksheets("Tirage").Range("B3")

  Dim col As Variant
  For Each col In Array("B", "D", "F")
    With ThisWorkbook.Worksheets("Tirage").Range(col & 3)
      Set myRng = Application.Union(myRng, Range(.Cells, .End(xlDown)))
    End With
  Next col

  Dim noDuplicates As Object
  Set noDuplicates = CreateObject("Scripting.Dictionary")

  Dim c As Variant
  For Each c In myRng.Cells
    noDuplicates(c.Value2) = c.Value2
  Next c

  ThisWorkbook.Worksheets("Inscriptions").Range("A3:A" & noDuplicates.Count + 1) = Application.Transpose(noDuplicates.Keys())
End Sub

Merci pour votre aide

Crdlt

bonjour Joco7915,

Sub SansDoublons()
     Dim Dict, col, i, N, aA

     Set Dict = CreateObject("scripting.dictionary")
     Dict.comparemode = vbTextCompare        'ignorer majuscules/miniscules

     With Sheets("feuil1")
          For Each col In Array("A", "D", "G")
               aA = .Range(.Cells(3, col), .Cells(Rows.Count, col).End(xlUp)).Value     'array avec contenu d'une plage
               For i = 1 To UBound(aA)
                    If Len(aA(i, 1)) > 0 Then Dict(aA(i, 1)) = vbEmpty     'ajouter au dictionaire
               Next
          Next
     End With

     N = Dict.Count                          'nombre d'éléments dans le dictionaire
     If N = 1 Then Dict([Rnd]) = vbEmpty     'ajouter un dummy s'il n'y a qu'un élément

     With Sheets("feuil2").Range("A2")
          .Resize(29).ClearContents          'vider la plage
          .Resize(N).Value = Application.Transpose(Dict.keys)     'coller le contenu du dictionaire (sans le dummy)
     End With

End Sub

Bonjour Joco7915 ,

Je ne comprends pas ce que vient faire l'en-tête en B2.

Votre code semble bien prendre en compte pour le dictionary les données des colonnes B, D et F à partir de la ligne 3.

Mais votre restitution m'apparait erronée.

ThisWorkbook.Worksheets("Inscriptions").Range("A3:A" & noDuplicates.Count + 1) = Application.Transpose(noDuplicates.Keys())

1) Souvent avant de coller les nouveaux résultats, on efface les anciens (ça évite des déboires).

ThisWorkbook.Worksheets("Inscriptions").Range("a3:a" & Rows.Count).ClearContents

2) La restitution

Le nombre de valeurs à coller est noDuplicates.Count

or on colle à partir de A3, c'est donc Range("a3:a" & ( 2 + noDuplicates.Count) ). Le nombre de cellule est la ligne sup. - la ligne inf +1

soit 2 + noDuplicates.Count - 3 +1 soit 2 + 2 + noDuplicates.Count -2 soit 2 + noDuplicates.Count

Pour ne pas se planter, il est plus simple d'écrire car pas de calcul de ligne de fin :

ThisWorkbook.Worksheets("Inscriptions").Range("a3" .resize(noDuplicates.Count) = Application.Transpose(noDuplicates.Keys)

Bonsoir

Merci pour vos solutions mais le problème existe toujours dans la feuille ou le collage s'effectue les cellules de la ligne 2 sont présentes

alors qu'il ne me faut qu'a partir de la ligne 3

Crdlt

Re,

Essayez le nouveau code joint ci-dessous.

Après 2448 messages, il faut nous encore solliciter de votre haute bienveillance la bonté de gratifier les pauvres manants que nous sommes d'un classeur représentatif !

Le code à tester :

Sub CopieSansDoublonsX()
   Dim dico As Object, wDest As Worksheet, col, t, i

   Set dico = CreateObject("Scripting.dictionary"): dico.comparemode = vbTextCompare      ' création dico
   ' effacement des précédents réultats
   Set wDest = ThisWorkbook.Worksheets("Inscriptions"): wDest.Range("a3:a" & Rows.Count).ClearContents

   With ThisWorkbook.Worksheets("Tirage")
      For Each col In Split("b d f")
         'prendre à partir de la première ligne et prendre deux colonnes pour s'assurer d'avoir un tableau
         t = .Range(.Cells(1, col), .Cells(Rows.Count, col).End(xlUp)).Resize(, 2).Value2
         If UBound(t) > 2 Then         ' seulement si le tableau à 3 lignes ou plus
            For i = 3 To UBound(t)     ' boucle à partir de la ligne 3
               If t(i, 1) <> "" Then dico(CStr(t(i, 1))) = t(i, 1)   ' si non vide on met dans le dico
            Next i
         End If
      Next col
   End With

   ' si au moins un élément dans dico, alors transfert sur la feuille à partir de la cellule a3
   If dico.Count > 0 Then wDest.Range("a3").Resize(dico.Count).value2 = Application.Transpose(dico.Items)
End Sub

Bonjour

Le résultat est toujours pareil

j'ai un peu modifié je vous joins le fichier

Crdlt

Bonjour à tous,

@Joco si je peux me permettre une petite remarque je ne comprends vraiment pas cette manière de faire que vous avez à faire des mini-demandes sur des exemples non représentatifs et ensuite ouvrir de nouveaux fils sur le meme sujet parce qu’au final votre demande/exemple dans le premier fil n’est pas assez précis(e).

Les remarques de mafraise et bart concernant mon code sont correctes, j’ai effectivement mal géré l’export du dictionnaire.

Mais je trouve osé de votre part de vous “approprier” une solution que de toute évidence vous ne comprenez absolument pas puisqu’il est quand meme écrit “.Range(col & 3)” et vous demandez pourquoi on va chercher dans B2…

En exécutant le code pas à pas et en regardant les adresses des variables on se rend bien compte que la ligne 2 n'est jamais accédée.

Copier coller sans doublons

Bref pour faire court, si vous ne comprenez pas le VBA, aucun soucis, mais ne feintez pas une pseudo compréhension car cela rend juste le travail plus confus pour les gens qui vous aident.

Enfin pour terminer, sur votre classeur d’exemple quand je lance ma macro initiale, corrigée pour le nombre de lignes, je n’ai pas les titre qui apparaissent. Je ne sais pas ce que vous avez pu trafficotter. Notez que votre colonne F est vide d’ailleurs.

Sub CopieSansDoublons()
  Dim myRng As Range
  Set myRng = ThisWorkbook.Worksheets("Tirage").Range("B3")

  Dim col As Variant
  For Each col In Array("B", "D", "F")
    With ThisWorkbook.Worksheets("Tirage").Range(col & 3)
      Set myRng = Application.Union(myRng, Range(.Cells, .End(xlDown)))
    End With
  Next col

  Dim noDuplicates As Object
  Set noDuplicates = CreateObject("Scripting.Dictionary")

  Dim c As Variant
  For Each c In myRng.Cells
    noDuplicates(c.Value2) = c.Value2
  Next c

  With ThisWorkbook.Worksheets("Inscriptions").Range("A3")
    Range(.Cells, .End(xlDown)).ClearContents
    .Resize(noDuplicates.Count) = Application.Transpose(noDuplicates.Keys())
  End With
End Sub

Bonjour

Tout d'abord mais excuses si je fais des erreurs ,j'ai 76 ans et j'ai commencé à faire un peu d'informatique il y a 10 ans

Le code fonctionne bien ,mais si je clique sur un bouton tirage exemple tirage tour 1 de la feuil Tirage ,la cellule la cellule Tirage tour 1 apparait dans le collage

alors qu"elle ne devrait pas y être

voir le fichier

Vous aviez effectivement modifié la macro initiale au point critique que je mentionnais dans mon dernier message : en changeant l’indice de ligne de 3 vers 2, d’où “l’erreur”. Ensuite vous avez mis ce code dans l’event de la feuille, ce qui le redéclenchait à chaque tirage et supprimait le travail des diverses solutions qui vous ont été proposées.

Ci-joint un fichier un peu corrigé, en conservant votre appel à la fonction de tri dans l’event, meme si selon moi il faudrait mieux la mettre après votre tirage.

Edit : vous pouvez si vous le souhaitez, remplacer l’appel à ma macro par celle de votre préférence entre Bart et Mafraise, qui effectuent davantages de tests quant à vos valeurs, pour traiter les cas de tableaux vides par exemples. Je ne les ai pas testés mais en les lisant ils me semblent tout à fait corrects.

Merci pour la solution

Bonjour à tous !

Non, je ne vais pas proposer de solution... Mais je vois que Joco a 76 ans et qu’il pratique l’informatique depuis 10 ans…

Je voulais simplement lui souhaiter un bon anniversaire d'inscription, car cela fait exactement 5 ans aujourd'hui qu'il s'est inscrit ici !

Je suis sûr qu'il ne l'avait même pas remarqué lui même !