Coller des valeurs en fonction d'un critère

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

Bonjour kim_ono, le forum,

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)
                Lig_Ecriture = Lig_Ecriture + 1
            End If
            Num_Ligne = Num_Ligne + 1
    Wend
End Sub

Autre possibilité à tester...

Option Explicit

Dim tablo, tabloR()
Dim i&, j&, k&

Sub Transfert()
    tablo = Sheets("Feuil1").Range("A1").CurrentRegion

    k = 0
    For i = 2 To UBound(tablo, 1)
        If tablo(i, 2) = "Non" Then
            ReDim Preserve tabloR(1 To 2, 1 To k + 1)
            For j = 1 To 2
                tabloR(j, 1 + k) = tablo(i, j)
            Next j
            k = 1 + k
        End If
    Next i
     Sheets("Feuil2").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    On Error Resume Next
     Sheets("Feuil2").Range("A2").Resize(UBound(tabloR, 2), 2) = Application.Transpose(tabloR)
     Sheets("Feuil2").Activate
End Sub

CTRL + e pour exécuter la macro

Cordialement,

Grand merci pour ta réactivité et ta solution apportée qui marche très bien.

De plus le code est très court ce qui est un plus.

Par contre, peux tu commenter tes lignes de codes. Je vois à peu près de quoi ça parle mais je pense que des commentaires dans le code seraient les bienvenus.

Grand merci encore

Re,

Merci pour ton retour,

Option Explicit

Dim tablo, tabloR()
Dim i&, j&, k&

Sub Transfert()
    tablo = Sheets("Feuil1").Range("A1").CurrentRegion '..........................................on stocke les données de la feuille Feuil1 dans une variable tableau

    k = 0 '.......................................................................................intialisation de la variable k (ligne du tableau)
    For i = 2 To UBound(tablo, 1) '...............................................................on boucle sur toutes les ligne de tablo à partir de la deuxième (sans le titre)
        If tablo(i, 2) = "Non" Then '.............................................................si la 2° colonne de tablo est "Non"
            ReDim Preserve tabloR(1 To 2, 1 To k + 1) '...........................................On définit la variable TabloR qui va contenir, transposé, le tableau (tablo)
            For j = 1 To 2 '......................................................................on boucle sur  les 2 colonnes de la ligne
                tabloR(j, 1 + k) = tablo(i, j) '..................................................on écrit les données dans tabloR
            Next j
            k = 1 + k '...........................................................................on incrémente la variable k afin d'ajouter une colonne à la variable tabloR
        End If
    Next i '......................................................................................On passe à la ligne suivante de tablo
     Sheets("Feuil2").Range("A1").CurrentRegion.Offset(1, 0).ClearContents '......................on efface les données existantes à partir de la ligne 2
    On Error Resume Next '........................................................................si on rencontre une erreur, on poursuit
     Sheets("Feuil2").Range("A2").Resize(UBound(tabloR, 2), 2) = Application.Transpose(tabloR) '..on écrit les données du tabloR sur Feuil2 à partir de A2
     Sheets("Feuil2").Activate '..................................................................on active Feuil2 (facultatif)
End Sub

Un grand merci à gmb dont je me suis largement inspiré,

Cordialement,

Bonjour,

Je te remercie pour cet effort explicatif conséquent.

Cela va m'aider à comprendre la logique des tableaux dans VBA.

En effet, je n'utilise pas encore les procédures VBA par tableau mais cela est visiblement efficace et me donne des idées pour la suite.

Grand merci encore