Copies de cellules sous condition vers une autre feuille

Bonjour à tous,

ayant arrêté de programmer en vba depuis plus de 8 ans et ayant un travail urgent a terminer, je sollicite votre aide....

Mon problème est le suivant .... sur une feuille, j'ai des données dans la zone col A ligne 2 jusque col AJ ligne 150.

je voudrais copier pour chaque ligne les valeurs contenues dans les col a a f si la valeur dans la col f est différente de "S" dans une autre feuille mais sans laisser de ligne vide entre les cellules copiées.....

Merci d'avance pour l'aide que vous pourrez m'apporter

Vincentnini

Bonjour Vincent, bonjour le forum,

Essaie comme ça :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OS = Worksheets("Feuil1") 'définit l'onglet source OS (à adapter)
Set OD = Worksheets("Feuil2") 'définit l'onglet destination OD (à adapter)
TV = OS.Range("A2").CurrentRegion 'définit le tableau des valeurs TV
K = 1 'initialise la variable K
For I = 1 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV
    If TV(I, 6) <> "S" Then 'condition : si la donnée ligne I colonne 6 (=> colonne F) de TV est différente de "S"
        ReDim Preserve TL(1 To 6, 1 To K) 'redimentionne le tableau des lignes (6 lignes (=> aux colonne A à F) , K colonnes)
        For J = 1 To 6 'boucle 2 : sur 6 colonnes (équivalentes aux colonnes A à F)
            TL(J, K) = TV(I, J) 'récupère dans la ligne J de TL la donnée en colonne J de TV (= Transposition)
        Next J 'prochaine colonne de la boucle 2
        K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
'si K est supérieure à 1 renvoie dans A1 redimensionnée de l'onglet OD, le tableau TL tgransposé
If K > 1 Then OD.Range("A1").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
End Sub

Grand merci, j essaye ce soir...


la ligne If TV(I, 6) <> "S" Then me donne une erreur de compilation : erreur de syntaxe...

Re,

Essai avec :

If Not TV(I, 6) = "S" Then

Sinon le fichier ! Qu'on puisse tester et comprendre...

Ci joint le fichier.....

mon but, copier a partir de la feuille mai vers la feuille juin le contenu des colonnes noms, num de séjour et filière si filière est différent de "S" .

Les lignes copiées étant a mettre dans la feuille juin à la suite l'une de l'autre

74testcopiemacro.xlsm (364.14 Ko)

Re,

Entre toi qui te mélange les pinceaux dans les colonnes et moi qui me plante dans le code on ne pouvait pas y arriver ! Comme quoi, rien de mieux que le fichier qui va bien...

Le code modifié :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OS = Worksheets("mai") 'définit l'onglet source OS
Set OD = Worksheets("juin") 'définit l'onglet destination OD
DL = OD.Range("A1").End(xlDown).Row 'définit la dernière ligne DL du tableau
TV = OS.Range("A2:C" & DL) 'définit le tableau des valeurs TV
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV
    If Not TV(I, 3) = "S" Then
    ReDim Preserve TL(1 To 3, 1 To K) 'redimentionne le tableau des lignes (3 lignes (=> aux colonne A à C) , K colonnes)
    For J = 1 To 3 'boucle 2 : sur 3 colonnes (équivalentes aux colonnes A à C)
        TL(J, K) = TV(I, J) 'récupère dans la ligne J de TL la donnée en colonne J de TV (= Transposition)
    Next J 'prochaine colonne de la boucle 2
    K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
'si K est supérieure à 1 renvoie dans A1 redimensionnée de l'onglet OD, le tableau TL tgransposé
If K > 1 Then OD.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
End Sub

Super......vous m avez fait gagner un temps énorme...... A plus et encore marci

Re

Da rian !...

Rechercher des sujets similaires à "copies condition feuille"