XL 2021 Souci de Macro qui créé des doublons

fanou06

XLDnaute Occasionnel
Bonsoir,

Sur mon fichier dans l'onglet RDV je souhaitais quand je clique sur UNPAID ou autre bouton se trouvant en I1 que les états des paiements s'affichent dans des onglets spécifiques.
Par exemple : Quand je clique sur UNPAID, je souhaite que tous les noms avec l'état NON PAYE de l'onglet RDV se copient dans l'onglet RDV NON PAYES.
Mon souci est que chaque fois que je lance la macro elle copie tous les noms, même ceux déja notés et datés. J'ai donc des doublons avec cette macro.


VB:
Sub RDVGratuits()
        Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim searchWord As String
    
    ' Sur la feuille "RDV"
    Set wsSource = ThisWorkbook.Worksheets("RDV")
    
    ' Copier sur la feuille "RDV GRATUITS" selon les données demandées
    Set wsDestination = ThisWorkbook.Worksheets("RDV GRATUITS")
    
    ' Recherche "GRATUIT"
    searchWord = "GRATUIT"
    
    lastRow = wsSource.Cells(wsSource.Rows.Count, "F").End(xlUp).Row
    
    For i = 1 To lastRow
        If InStr(1, wsSource.Cells(i, "F").Value, searchWord, vbTextCompare) > 0 Then
            wsSource.Rows(i).Copy wsDestination.Rows(wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1)
        End If
    Next i
End Sub


Sub RDVAnnules()
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim searchWord As String
    
    ' Feuille "RDV" contenant les données
    Set wsSource = ThisWorkbook.Worksheets("RDV")
    
    ' Copier la recherche dans la feuille "RDV ANNULES"
    Set wsDestination = ThisWorkbook.Worksheets("RDV ANNULES")
    
    ' Rechercher "ANNULE"
    searchWord = "ANNULE"
    
    lastRow = wsSource.Cells(wsSource.Rows.Count, "F").End(xlUp).Row
    
    For i = 1 To lastRow
        If InStr(1, wsSource.Cells(i, "F").Value, searchWord, vbTextCompare) > 0 Then
            wsSource.Rows(i).Copy wsDestination.Rows(wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1)
        End If
    Next i
End Sub

Sub RDVNonpayes()
       Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim searchWord As String
    
    ' Feuille "RDV"
    Set wsSource = ThisWorkbook.Worksheets("RDV")
    
    ' Copier dans la feuille "RDV NON PAYES"
    Set wsDestination = ThisWorkbook.Worksheets("RDV NON PAYES")
    
    ' Rechercher "NON PAYE"
    searchWord = "NON PAYE"
    
    lastRow = wsSource.Cells(wsSource.Rows.Count, "F").End(xlUp).Row
    
    For i = 1 To lastRow
        If InStr(1, wsSource.Cells(i, "F").Value, searchWord, vbTextCompare) > 0 Then
            wsSource.Rows(i).Copy wsDestination.Rows(wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1)
        End If
    Next i
End Sub


Je ne sais pas si je peux continuer à l'utiliser en ajoutant une ligne de commande ?


merci pour votre aide.
 

Pièces jointes

  • CRICRI FACTURES_V2.xlsm
    94.8 KB · Affichages: 1

TooFatBoy

XLDnaute Barbatruc
C'est à dire de l'effacer ?
Dans ce cas je peux mettre au début de l'exécution de la macro un "effacement" ?
En fait je voulais dire : est-ce que tu as toutes les données dans la feuille "RDV" ?
C'est-à-dire : il n'y a aucune donnée qui a été copiée dans la feuille "RDV NON PAYE" et qui a ensuite été supprimée de la feuille "RDV", donc on peut mettre au début de l'exécution de la macro un "effacement" sans perdre de données ?


Ce que tu veux obtenir, par exemple en feuille "RDV NON PAYES" (c'est obligé les majuscules partout ? 😇), c'est la même chose que le tableau de la feuille "RDV" filtré pour ne laisser apparaître que les "NON PAYE" ???

Si c'est bien ça, je te conseillerai de commencer par utiliser des TS (Tableaux Structurés).
Attention : dans un TS toutes les colonnes doivent avoir des en-têtes différents, pas pas possible d'avoir deux fois "TARIF".
 
Dernière édition:

Discussions similaires

Réponses
2
Affichages
113

Statistiques des forums

Discussions
312 206
Messages
2 086 220
Membres
103 158
dernier inscrit
laufin