Transfert des données d'une feuille Excel à une autre selon conditions

Résolu
aitelhachmi Messages postés 25 Statut Membre -  
aitelhachmi Messages postés 25 Statut Membre -
Bonjour,

J'aimerais pouvoir appliquer un code VBA pour transférer des données de la feuille1 vers la feuille2 seulement si la colonne "État" contient la valeur "OK"

- Par exemple :

Les lignes 5 et 7 et 8 de mon tableau contiennent la Valeur "OK" dans la colonne "État" dans la feuille1

Résultat ==> Transférer de A5 à J5 et de L5 à Q5 (feuille1) >> vers >> (Feuille2) la dernière ligne vide de la colonne A à J et de M à R (Faire de même avec les lignes 7 et 8 de la feuille1)

Voici le lien de téléchargement du modèle sur quoi je veux appliquer le code VBA :
https://onedrive.live.com/redir?resid=24D5D8E53C3C23B1!215939&authkey=!AKpwzHJE_B2JzrI&ithint=file%2cxlsx&e=NzLam4

Je vous remercie d'avance.

Configuration: Windows / Firefox 81.0

3 réponses

  1.
    cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Bonjour,

    faire une boucle si la colonne "État" contient la valeur "OK":

    https://www.developpez.net/forums/d605223/logiciels/microsoft-office/excel/contribuez/boucles-parcourir-colonne-ligne-plage-donnees-2-methodes/

    Copier de A5 à J5 et de L5 à Q5 (feuille1):

    https://docs.microsoft.com/fr-FR/office/vba/api/Excel.Range.Copy

    coller (Feuille2) la dernière ligne vide de la colonne A à J et de M à R :

    https://excel-malin.com/tutoriels/vba-tutoriels/vba-trouver-la-derniere-cellule-utilisee/

    voilà

    1
  2. aitelhachmi Messages postés 25 Statut Membre
     
    Rebonjour,

    Merci infiniment pour votre aide, je vais me renseigner et se baser sur ces liens pour en tirer une conclusion pour résoudre mon problème.
    0
  3. aitelhachmi Messages postés 25 Statut Membre
     
    C'est bon, j'ai trouvé une solution excellente pour mon problème avec le code suivant : 
    Option Explicit
    Sub transfer_orders()
    Application.ScreenUpdating = False

    Dim f1 As Worksheet, f2 As Worksheet, data, extrait, i, j, n, debut
        Set f1 = Sheets("Feuil1")
        Set f2 = Sheets("Feuil2")
        debut = 3
        data = f1.Range("A" & debut).CurrentRegion.Value
        n = 0
        ReDim extrait(1 To UBound(data, 2) + 1, 1 To 1)
        For i = 2 To UBound(data)
            If data(i, 11) = "OK" Then
                f1.Range("K" & debut + i - 1) = "Transféré"
                n = n + 1
                ReDim Preserve extrait(1 To UBound(data, 2) + 1, 1 To n)
                For j = 1 To 10
                    extrait(j, n) = data(i, j)
                Next
                For j = 12 To UBound(data, 2)
                    extrait(j + 1, n) = data(i, j)
                Next
            End If
        Next
        f2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(extrait, 2), UBound(extrait)) = Application.Transpose(extrait)

    Application.ScreenUpdating = True
    End Sub
    0