Transfert d'une ligne de la feuille 1 a la feuille 2 avec condition Merci


#1

Bonjour A Vous Tous :smile:

Voila, c’est Mon Premier Sujet et je suis un peux perdu
Dans un Classeur Paiement Cheque Je veux transférer
une ligne si la condition est Oui, ci joint un fichier pour mieux comprendre
Merci A Vous.paiement.xlmx.xlsm (18,1 Ko)


#2

Bonsoir @sadi58,

Voici une proposition par VBA:

Dans la “Feuil1” cliquer sur le bouton “Go” après avoir mis “Oui où Non” dans la colonne “E”, si les conditions sont Oui, alors les lignes sont copiées dans la feuille “Résultat”, si dans la colonne “E”, si les conditions sont Non, alors les lignes sont supprimées dans la feuille “Résultat”,

Voici le code VBA:

Sub extract()

     Dim feuil As Worksheet
     Dim nbLignes%, lastLigneFeuil%, Compteurlignes%
     Dim plageCellules As Range
     Compteurlignes = 0
     Application.ScreenUpdating = False
     Worksheets("Résultat").Range("A1:E1048576").ClearContents
     Worksheets("Résultat").Range("A1:E1048576").Borders.LineStyle = xlNone
     Worksheets("Résultat").Range("A1") = "Date"
     Worksheets("Résultat").Range("B1") = "Désignations"
     Worksheets("Résultat").Range("C1") = "N° Chèques"
     Worksheets("Résultat").Range("D1") = "Montant"
     Worksheets("Résultat").Range("E1") = "Paiement"
          
     Worksheets("Résultat").Range("A1:E1").Font.Bold = True
     Worksheets("Résultat").Range("A1:E1").HorizontalAlignment = xlCenter
     Worksheets("Résultat").Range("A1:E1").CurrentRegion.Borders.Weight = xlMedium
     
     nbLignes = Sheets("Résultat").Range("E1048576").End(xlUp).Row
         
     For Each feuil In ThisWorkbook.Sheets
         If Not feuil.Name = "Résultat" Then
            lastLigneFeuil = feuil.Range("E1048576").End(xlUp).Row
             
             For x = 2 To lastLigneFeuil
                 If feuil.Cells(x, 5).Value = "Oui" Then
                     feuil.Cells(x, 5).EntireRow.Copy Destination:=Sheets("Résultat").Cells(nbLignes + 1, 1).Offset(Compteurlignes, 0).EntireRow
                     Compteurlignes = Compteurlignes + 1
                 End If
             Next
         End If
     Next feuil

End Sub

Ci joint ton fichier en retour ICI==> sadi58 V1.xlsm (30,7 Ko)

Cordialement.


#3

Bonsoir mdo100

Merci Beaucoup de votre réponse si rapide, Je vous en suis trés reconnaissant vous m’avez
donner un coup de main
C’est jentille Merci
Bonne Nuit


#4

@mdo100 l’homme qui solutionne plus vite que son ombre :smiley:


#5

Bonsoir @DocteurExcel,

N’exagérions rien, je n’ai pas ton expérience. :blush:
Mais il se trouve qu’il y a quelques jours j’ai du solutionner un problème similaire, du coup je n’ai pas eu beaucoup de travail a faire pour l’ami @sadi58.

Merci pour le compliment :+1:

Bonne soirée.
Bien cordialement.