With end With

[Bruce68]

Bonsoir à tous

J'ai une macro pour supprimer les doublons de mes fournisseurs, Ce que je veux faire c'est enregistrer le résultat dans un autre onglet appelé "Resultat" pour cela j'ai utilise With shetts ("Resultat") et end With pour rester dans la feuille "Listes"quand la macro arrive à: .Range("B" & ligne).Select j'ai le message suivant= La Méthode Sélect de la classe Range a échoué.
Si je supprime le . devant Range j'ai la recopie qui se fait sur la Feuille Listes sans enlever Le With et end with.
Que faire pour que cela fonctionne.
Merci de votre aide

 

[Papou-net]

Re : With end With

Bonsoir Bruce68,

Essaie avec ce code simplifié :

Sub Doubl()
derlig = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Range("A2:" & ("G" & derlig)).Sort _
  Key1:=Range("A2"), Order1:=xlAscending, _
  Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
With Sheets("Resultat")
  .Range("B2:" & ("B" & derlig)).ClearContents
  ligne = 2
  For i = 2 To derlig
    If Range("A" & i) <> Range("A" & i - 1) Then
      .Range("B" & ligne).Value = Range("A" & i).Value
    End If
  Next i
End With
End Sub

NB : tu devrais soigner l'indentation de tes lignes de code, ça simplifie la relecture et la recherche des erreurs.

Espérant avoir répondu.

Cordialement.

 

[Robert]

Re : With end With

Bonsoir Bruce, bonsoir le forum,

À partir d'un onglet donné, tu ne peux pas sélectionner une cellule ou une plage d'un autre onglet sans avoir sélectionné au préalablement l'autre onglet lui même. Même avec un With... End With.
Il faut toujours éviter autant que possible les Select qui ne font que ralentir l exécution du code...
Ton code corrigé :

Sub Doubl()
Dim dest As Range

    derlig = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row    Range("A2:" & ("G" & derlig)).Sort _
        Key1:=Range("A2"), Order1:=xlAscending, _
    Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    
   With Sheets("resultat")
        Range("B2:" & ("B" & derlig)).ClearContents
    End With
    
    ligne = 2
    For i = 2 To derlig
        Xsel = Range("A" & i)
            If Xsel <> Range("A" & i - 1) Then
                With Sheets("Resultat")
                   Set dest = .Range("B" & ligne) ' Cette Ligne ne fonctionne pas
                    ligne = ligne + 1
                End With
                Range("A" & i).Copy dest
            End If
            Next i
 End Sub

Sinon, une autre manière plus rapide de faire la même chose tirée du site de Jacques BOISGONTIER :

Sub Doubl()
Dim dico As Object 'déclare la variable dico (DICtiOnnaire)
Dim dl As Integer 'déclare la variable  dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)

Set dico = CreateObject("Scripting.Dictionary") 'définit le dictionnaire dico
With Sheets("Listes") 'prend en compte l'onglet "Listes"
    dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la derni`re ligne éditée de la colonne 1 (=A)
    Set pl = .Range("A2:A" & dl) 'définit la plage pl
    pl.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With 'fin de la prise en compte de l'onglet "Listes"
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
    dico(cel.Value) = "" 'alimente le dictionnaire dico
Next cel 'prochaine cellule de la boucle
With Sheets("Resultat") 'prend en compte l'onglet "Resultat"
    .Range("B2").Resize(.Range("B1").CurrentRegion.Rows.Count).ClearContents 'supprime les anciennes données
    .Range("B2").Resize(dico.Count) = Application.Transpose(dico.keys) 'place la liste sans doublons dans B2
End With 'fin de la prise en compte de l'onglet "Resultat"
End Sub

[Edition]
Bonsoir Papou-Net, Roger, on s'est croisé. Waow Roger super ton nouvel avatar !

 

[ROGER2327]

Re : With end With

Bonsoir à tous


Sur la base de la procédure initiale :

Sub Doubl()
    Dim i&, derlig&, ligne&, fl As Worksheet

    With Sheets("Listes")
        derlig = .Range("A" & .Rows.Count).End(xlUp).Row

        .Range("A2:G" & derlig).Sort Key1:=.Range("A2"), Order1:=xlAscending, _
            Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

        Set fl = Sheets("Resultat")

        fl.Range("B2:B" & derlig).ClearContents
        ligne = 2
        For i = 2 To derlig
            If .Range("A" & i) <> .Range("A" & i - 1) Then
                .Range("A" & i).Copy Destination:=fl.Range("B" & ligne)
                ligne = ligne + 1
            End If
        Next i
    End With

End Sub

ROGER2327
#6256

Lundi 9 Phalle 139 (Godemiché, économe - fête Suprême Quarte)
2 Fructidor An CCXX, 0,0037h - millet
2012-W33-7T00:00:32Z

 

[Bruce68]

Re : With end With

Bonjour Papou-Net, Robert, Roger2327 et le forum

Je vous remercie de vos réponse chacune d' elle fonctionne à merveille.

Bon dimanche à vous tous

 

[Staple1600]

Re : With end With

Bonjour à tous

Bruce68
Pourquoi ne pas simplement utiliser le filtre élaboré qui inclus l'extraction sans doublons ?
(et ce avec ou sans macros)

Ci-dessous un exemple de macro avec le filtre élaboré

Sub Macro2()
'
' Macro2 Macro
' Macro enregistrée le 19/08/2012 par Staple1600
'
Dim Donnees As Range
Dim SansDoublons As Range
With Sheets("Listes")
    Set Donnees = .Range(.[A1], .[A65536].End(xlUp))
End With
Donnees.Sort Key1:=Sheets("Listes").Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Donnees.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set SansDoublons = Sheets("Listes").[_FilterDataBase]
SansDoublons.Offset(1, 0).Resize(SansDoublons.Rows.Count - 1).SpecialCells(12).Copy Sheets("Resultat").[B2]
Sheets("Listes").ShowAllData
End Sub

PS: Dans ton fichier exemple, la formule ne devrait pas être =NB.SI(B2:B2000;">""")
puisque il semble qu'il faille recopier en colonne B, non ? (L'entête étant en B1)