Copier la ligne si cellule non vide - VBA

Bonjour à tous,

Je suis nouveau sur le forum et j'en profite pour vous souhaiter une bonne année 2017 !

Je ne sais pas coder mon idée et pourtant cela me parait simple

Je vous expose mon désir !

J'ai un classeur Excel comportant plusieurs feuilles et je voudrais copier toutes les lignes de la feuille "HONO" vers une nouvelle feuille "VALEURS" mais seulement si la Colonne F de la feuille "HONO" est différente de "0".

Autrement dit, Copier la LIGNE 1 si est seulement SI la CELLULE F1 <> 0

Aussi je voudrais coller que les valeurs et non les formules (et sans mise en formes)

Merci pour votre aide !

Bonjour Franck, bonjour le forum,

Sans fichier difficile d'être précis. Essaie ce code qui devrait fonctionner si tes données commencent en A1 de l'onglet HONO :

Sub Macro2()
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 NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OS = Worksheets("HONO") 'définit l'onglet source OS
Set OD = Worksheets("VALEURS") 'définit l'onglet destination OD
OD.Range("A1").CurrentRegion.ClearContents 'supprime d'éventuelles ancienne données de l'onglet destination
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
K = 1 'initialsie la variable K
For I = 1 To NL 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV
    If TV(I, 6) <> 0 Then 'condition : si la donnée ligne I colonne 6 (=> colonne F) est différente de zéro
        ReDim Preserve TL(1 To NL, 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
        For J = 1 To NL 'boucle 2 : sur toutes les colonnes de TV (ou toutes les lignes de TL)
            TL(J, K) = TV(I, J) 'récupère dans la ligne J de TL la donnée dans la colonne J de TV (=transposition)
        Next J 'prochaine colonne de la boucle 2
        K = K + 1 'incrémente K
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
'si K est supérieure à un, renvoie dans la cellule A1 redimensionnée de l'onglet destination, le tableau TL transposé
If K > 1 Then OD.Range("A1").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
End Sub

Bonjour ThauThème,

Merci pour cette réponse rapide !

Je te joints un exemple !

J'ai oublié d'ajouter le bouton sur l'onglet HONO

Re ThauTheme

en fait je dois copier les lignes depuis la cellule A2 car la LIGNE 1 = Entete

J'ai copier / coller ton code que j'essaie de comprendre meme si très bien commenté !!!

J'ai donc modifié A1 par A2

Aussi je ne comprends pas s'il faut mettre le nombre de ligne et le nombre de colonne des les Variables NL et NC

Enfin, si je colle le code et que je lance via un Bouton, j'ai le message d'erreur "Erreur d'éxecution '9' : L'indice n'appartient pas à la sélection." sur

TL(J, K) = TV(I, J) 'récupère dans la ligne J de TL la donnée dans la colonne J de TV (=transposition)

Re,

En effet, il y avait une erreur dans mon premier code. Le code corrigé et adapté :

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 NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OS = Worksheets("HONO") 'définit l'onglet source OS
Set OD = Worksheets("VALEURS") 'définit l'onglet destination OD
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
OD.Range("A1").CurrentRegion.ClearContents 'supprime d'éventuelles ancienne données de l'onglet destination
OD.Range("A1").Resize(1, NC).Value = Application.Index(TV, 1) 'copie la ligne des étiquettes
K = 1 'initialsie la variable K
For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
   If TV(I, 6) <> 0 Then 'condition : si la donnée ligne I colonne 6 (=> colonne F) est différente de zéro
       ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
       For J = 1 To NC 'boucle 2 : sur toutes les colonnes de TV (ou toutes les lignes de TL)
           TL(J, K) = TV(I, J) 'récupère dans la ligne J de TL la donnée dans la colonne J de TV (=transposition)
       Next J 'prochaine colonne de la boucle 2
       K = K + 1 'incrémente K
   End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
'si K est supérieure à un, renvoie dans la cellule A2 redimensionnée de l'onglet destination, le tableau TL transposé
If K > 1 Then OD.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
End Sub

Re Re ThauTheme,

Et bien je te remercie enormément car ça marche !

J'ai peut être oublié une ou 2 conditions mais pour le moment ça reproduit bien les valeurs dans une autre feuille !