[XL-2010] Problème de méthode

Sub Suppr() Dim LastLig As Long Application.ScreenUpdating = False 'ThisWorkbook.Worksheets("Résultat").UsedRange.Clear With Worksheets("Suivi de commande") 'Ici on prends la colonne A comme référence pour chercher la ligne de la dernière cellule remplie de la feuille RDB LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row 'Tu copies les colonnes R et A de SDC vers A2 de Résultat .Range("R3", "R" & LastLig).Copy Worksheets("Résultat").Range("A2") .Range("A3", "A" & LastLig).Copy Worksheets("Résultat").Range("B2") End With 'Désormais en travaille après copie sur la feuille NoDuplicates 'Avec Colonne C: Là où on cherche les doublons legacy # 'Colonne F: C'est la colonne PMX With Worksheets("Résultat") .Range("A2", "A" & LastLig).Sort Key1:=.Range("A2"), Order1:=xlDescending, Header:=xlNo .Range("A2", "A" & LastLig).RemoveDuplicates Columns:=1, Header:=xlNo .Range("A2", "A" & LastLig).Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlNo End With End Sub

Bon j'ai cherché, j'ai bidouillé un truc si quelqu'un a une méthode plus intelligente et a la patiente de le poster je suis preneur.
(je mets le classeur test en pièce jointes.)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Sub Suppr()
 
Dim LastLig As Long, rc1 As Range, Lastlog As Long, Lastlag As Long
Dim devis As String, wr As Worksheet, wsdc As Worksheet, lig As Integer, wr2 As Worksheet
 
Set wr = ThisWorkbook.Worksheets("Résultat")
Set wsdc = ThisWorkbook.Worksheets("Suivi de commande")
Set wr2 = ThisWorkbook.Worksheets("R2")
 
Application.ScreenUpdating = False
'ThisWorkbook.Worksheets("Résultat").UsedRange.Clear
With wsdc
    'Ici on prends la colonne A comme référence pour chercher la ligne de la dernière cellule remplie de la feuille RDB
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    'Tu copies les colonnes R et A de SDC vers A2 de Résultat si (pas enlevé ("1"))
For lig = 3 To LastLig
    If wsdc.Cells(lig, 15).Value <> 1 Then
    ' copie ds la feuille résultat et recherche de première ligne vide
                 wr.Activate
                 wr.Range("A1").Select
                        If wr.Range("A2").Value <> "" Then ActiveCell.End(xlDown).Select
                            ActiveCell.Offset(1, 0).Select
                                ActiveCell.Value = .Cells(lig, 18).Value
                                ActiveCell.Offset(0, 1).Value = .Cells(lig, 1).Value
                                ActiveCell.Offset(0, 2).Value = .Cells(lig, 17).Value
 
        End If
    Next
End With
 
' on supprime les doublons de numéro de palette.
With wr
  Lastlog = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("A2", "C" & Lastlog).RemoveDuplicates Columns:=Array(2, 3), Header:=xlNo
    .Range("A2", "A" & Lastlog).Copy Worksheets("R2").Range("A2")
End With
' on cherche pour chaque devis le nombre de palette
With wr2
    Lastlag = .Cells(.Rows.Count, "A").End(xlUp).Row
' on supprime les doublons de n° de devis
    .Range("A2", "A" & Lastlag).RemoveDuplicates Columns:=(1), Header:=xlNo
'------------ boucle sur la feuille wr2 pour définir le nombre de palette et la somme des montants par devis
For lig = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
.Cells(lig, 2).Value = Application.CountIf(wr.Columns(1), .Cells(lig, 1).Value)
.Cells(lig, 3).Value = Application.WorksheetFunction.SumIf(wr.Columns(1), .Cells(lig, 1).Value, wr.Columns(3))
Next
End With
End Sub