Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

copier un resultat dans une autre feuille

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 !

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
 
- 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

Réponses
4
Affichages
177
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
479
Réponses
4
Affichages
461
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…