XL 2019 Coller des valeurs en fonction d'une condition

Kim_Ono

XLDnaute Nouveau
Bonjour à vous tous,

Je suis bloqué sur un problème en VBA.

En effet, j'ai saisi sur la feuille 1 des factures avec un numéro en colonne A (à partir de A2) et en colonne B j'ai saisi le commentaire Oui ou Non (oui pour facture payée et Non pour facture impayée).

Au lancement de ma macro VBA toutes les factures avec le commentaire Non doivent s'insérer dans la feuille 2 (c'est un copier coller).

Mon code marche à moitié.

En effet, lorsque je lance mon code toutes les factures avec le commentaire Non se collent correctement dans ma feuille 2 mais il y a des lignes vides.

Ce que je souhaite c'est que les factures avec le commentaire Non se collent en feuille 2 sans ligne vide. Elle doivent se coller dans la première ligne immédiatement disponible.

Je joins bien évidemment mon fichier.

Si une personne a la solution, je suis preneur.

En vous remerciant par avance
 

Pièces jointes

  • Facture payées impayée sur 2 feuilles.xlsm
    20.8 KB · Affichages: 13

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Kim_Ono,
Vous ne devez incrémenter votre index d'écriture que quand vous écrivez :
VB:
Sub Programme_Principal()
Dim Num_Ligne As Long
Dim Lig_Ecriture As Long
    Lig_Ecriture = 2
    Num_Ligne = 2
    While Sheets("Feuil1").Cells(Num_Ligne, 1) <> ""
           If Sheets("Feuil1").Cells(Num_Ligne, 2) = "Non" Then
                Sheets("Feuil2").Cells(Lig_Ecriture, 1) = Sheets("Feuil1").Cells(Num_Ligne, 1)
                Sheets("Feuil2").Cells(Lig_Ecriture, 2) = Sheets("Feuil1").Cells(Num_Ligne, 2)
                Lig_Ecriture = Lig_Ecriture + 1
            Else
                Sheets("Feuil2").Cells(Lig_Ecriture, 1) = ""
            End If
            Num_Ligne = Num_Ligne + 1
    Wend
End Sub
 

Phil69970

XLDnaute Barbatruc
Bonjour Kim_ono

Ceci devrait faire l'affaire

VB:
Option Explicit
Sub Programme_Principal()
Dim Num_Ligne As Long
Dim Lig_Ecriture As Long
    
Lig_Ecriture = 2
Num_Ligne = 2
While Sheets("Feuil1").Cells(Num_Ligne, 1) <> ""
    If Sheets("Feuil1").Cells(Num_Ligne, 2) = "Non" Then
         Sheets("Feuil2").Cells(Lig_Ecriture, 1) = Sheets("Feuil1").Cells(Num_Ligne, 1)
         Sheets("Feuil2").Cells(Lig_Ecriture, 2) = Sheets("Feuil1").Cells(Num_Ligne, 2)
     Else
         Sheets("Feuil2").Cells(Lig_Ecriture, 1) = ""
     End If
     Num_Ligne = Num_Ligne + 1
    Lig_Ecriture = Lig_Ecriture + 1
Wend

Sheets("Feuil2").Cells(Lig_Ecriture, 2).SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp)

End Sub

@Phil69970
 

Kim_Ono

XLDnaute Nouveau
Bonsoir Kim_Ono,
Vous ne devez incrémenter votre index d'écriture que quand vous écrivez :
VB:
Sub Programme_Principal()
Dim Num_Ligne As Long
Dim Lig_Ecriture As Long
    Lig_Ecriture = 2
    Num_Ligne = 2
    While Sheets("Feuil1").Cells(Num_Ligne, 1) <> ""
           If Sheets("Feuil1").Cells(Num_Ligne, 2) = "Non" Then
                Sheets("Feuil2").Cells(Lig_Ecriture, 1) = Sheets("Feuil1").Cells(Num_Ligne, 1)
                Sheets("Feuil2").Cells(Lig_Ecriture, 2) = Sheets("Feuil1").Cells(Num_Ligne, 2)
                Lig_Ecriture = Lig_Ecriture + 1
            Else
                Sheets("Feuil2").Cells(Lig_Ecriture, 1) = ""
            End If
            Num_Ligne = Num_Ligne + 1
    Wend
End Sub
 

Kim_Ono

XLDnaute Nouveau
Bonjour Kim_ono

Ceci devrait faire l'affaire

VB:
Option Explicit
Sub Programme_Principal()
Dim Num_Ligne As Long
Dim Lig_Ecriture As Long
   
Lig_Ecriture = 2
Num_Ligne = 2
While Sheets("Feuil1").Cells(Num_Ligne, 1) <> ""
    If Sheets("Feuil1").Cells(Num_Ligne, 2) = "Non" Then
         Sheets("Feuil2").Cells(Lig_Ecriture, 1) = Sheets("Feuil1").Cells(Num_Ligne, 1)
         Sheets("Feuil2").Cells(Lig_Ecriture, 2) = Sheets("Feuil1").Cells(Num_Ligne, 2)
     Else
         Sheets("Feuil2").Cells(Lig_Ecriture, 1) = ""
     End If
     Num_Ligne = Num_Ligne + 1
    Lig_Ecriture = Lig_Ecriture + 1
Wend

Sheets("Feuil2").Cells(Lig_Ecriture, 2).SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp)

End Sub

@Phil69970
 

Discussions similaires

Statistiques des forums

Discussions
311 721
Messages
2 081 929
Membres
101 843
dernier inscrit
Thaly