copier un resultat dans une autre feuille

raniou010

XLDnaute Nouveau
Bonjour , j'ai essayer de comprendre le problème mais malheureusement j'ai pas réussie , au faite ce code vérifie s'il y a des duplications dans la feuille 1 par rapport a des cellules(A,E,AM) puis il copie la ligne entiere dans une autre feuille , ce code fonctionne bien mais au niveau de la boucle For ou le résultat sera copié , la ligne(mon résultat) plusieurs fois .
voici le code
Sub CopyDuplicates()
Dim mycolor As Long, ws1 As Worksheet, ws2 As Worksheet, c1 As Integer, c2 As Integer, c3 As Integer 'Constantes
Dim i As Integer, ni As Integer, p As Integer, e As Integer, s As Integer, c As Integer, SearchID As String, MatchID As String 'Variables

'Déclaration constantes
Set ws1 = Sheet5 'Nom feuille 100'000 lignes
Set ws2 = Sheet6 ' Nom feuille où copier
c1 = 1 'Colonne A
c2 = 5 'Colonne E
c3 = 39 'Colonne AM

'Déclaration variables
With ws1
With .UsedRange
c = .Column 'Première colonne du tableau
s = .Row 'Première ligne du tableau
End With
e = .Cells(.Rows.Count, c).End(xlUp).Row 'Dernière ligne du tableau
End With
p = ws2.Cells(ws2.Rows.Count, c).End(xlUp).Row + 1 'Première ligne vide du tableau

'###############
'# DEBUT MACRO #
'###############

'Geler Excel
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

For i = s To e
SearchID = ws1.Cells(i, c1).Value & ws1.Cells(i, c2).Value & ws1.Cells(i, c3).Value
For ni = s To e
If i <> ni Then
MatchID = ws1.Cells(ni, c1).Value & ws1.Cells(ni, c2).Value & ws1.Cells(ni, c3).Value
If SearchID = MatchID Then
ws1.Cells(ni, 1).EntireRow.Copy Destination:=ws2.Rows(p)
p = p + 1
End If
End If
Next ni
Next i

'Dégeler Excel
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With

End Sub
 

Discussions similaires

Réponses
0
Affichages
352