Copier ligne si une cellule dans celle-ci est non-nulle, entre deux feuilles de calcul - macro

  • Auteur de la discussion jessymathault
  • Date de début

jessymathault

Nouveau membre
Bonjour à tous,

Premièrement, je tiens à préciser que je n'ai aucune formation autre qu'un peu d'essai erreur sur vba...

Mon but est de réussir à isoler rapidement les lignes qui contiennent des éléments et de copier celles-ci sur une autre feuille de calcul. Dans mon classeur, je peux savoir directement si la ligne est vide en ne regardant que les valeurs de la colonne H. Si H est nulle (en fait elle vaut "", donc 0), alors la ligne est vide et elle n'est pas à copier. Mon code, ci-bas, fonctionne, mais il est beaucoup trop lent... J'aimerais donc bien que vous m'aidiez à l'optimiser.

À noter que copier seulement les colonnes A à M selon la valeur de la colonne H pourrait suffire.

Code:
Sub Bouton1_Clic()

  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
  
  Sheets("COPIER ICI LES CELLULES NONVIDE").Activate ' feuille de destination
  
  Col = "H"                 ' colonne de la donnée non vide à tester
  NumLig = 2
  With Sheets("Produit à copier")     ' feuille source
  NbrLig = .Cells(65536, Col).End(xlUp).Row
  For Lig = 3 To NbrLig
    If .Cells(Lig, Col).Value <> "" Then
      .Cells(Lig, Col).EntireRow.Copy
      NumLig = NumLig + 1
      Cells(NumLig, 1).Select
      ActiveSheet.Paste
    End If
  Next
  End With
    
End Sub

Merci beaucoup de l'aide apportée!
 

drul

Obscur pro du hardware
Staff
Bon y a pas de solution miracle, tu est déjà sur la bonne voie.

qq point pour accélerer:

1) évite le presse papier (en plus éthiquement c'est mieux) (en faisant "gnagna. copy target" ça copie sans utiliser le presse papier)
2) Coupe l'update de l'écran au début de ta procedure (application.screenupdating = false) puis après la boucle, réactive le.
3) si tu as peu de ligne vide une bonne solution serait de copier l'ensemble de la feuille(c'est instantanée), puis de supprimer les lignes après la copie (ça c'est lent, comme la copie d'une seule ligne).

Voila si tu as plus de question, aucun souci.

Edit: un exemple de ce que ça peut donner:

Code:
  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
  Dim target As Range
  
  'Sheets("COPIER ICI LES CELLULES NONVIDE").Activate ' feuille de destination
  Application.ScreenUpdating = False
  Col = "H"                 ' colonne de la donnée non vide à tester
  NumLig = 2
  Set target = Sheets("COPIER ICI LES CELLULES NONVIDE").Cells(2, 1)
  With Sheets("Produit à copier")     ' feuille source
  NbrLig = .Cells(65536, Col).End(xlUp).Row
  .Range("A3:M" & NbrLig).Copy target
  NbrLig = Sheets("COPIER ICI LES CELLULES NONVIDE").Cells(65536, Col).End(xlUp).Row
  For Lig = NbrLig To 2 Step -1

    If Sheets("COPIER ICI LES CELLULES NONVIDE").Cells(Lig, Col).Value = "" Then
        Sheets("COPIER ICI LES CELLULES NONVIDE").Cells(Lig, Col).EntireRow.Delete
    End If
  Next
  Application.ScreenUpdating = True
  End With
 

drul

Obscur pro du hardware
Staff
Ton probleme me perturbait, alors, j'ai un peu chercher,

La meilleure solution est de passer par une mémoire tampon et d'écrire toutes les données d'un coup !

Code:
Sub Bouton1_Clic()

  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
  Dim target As Range
  Dim testbuffer As Variant
  Dim j As Long
  
  Col = "H"                 ' colonne de la donnée non vide à tester
  NumLig = 0
  Set target = Sheets("COPIER ICI LES CELLULES NONVIDE").Cells(2, 1)
  With Sheets("Produit à copier")     ' feuille source
  NbrLig = .Cells(65536, Col).End(xlUp).Row

  ReDim testbuffer(NbrLig, 13)
  
  For Lig = 3 To NbrLig

    If .Cells(Lig, Col).Value <> "" Then
        For j = 1 To 13
            testbuffer(NumLig, j - 1) = .Cells(Lig, j).Value
        Next
        NumLig = NumLig + 1
    End If
  Next
  Sheets("COPIER ICI LES CELLULES NONVIDE").Range("A2:M" & NumLig).Value = testbuffer
  End With
End Sub

P.S. il y surement moyen d'optimiser un peu ... (on peut surement copier toute la ligne d'un coup dans le buffer sans faire une deuxième boucle, mais j'ai plus le temps de chercher).
 

jessymathault

Nouveau membre


Ces codes sont effectivement beaucoup plus rapide que les miens! (le mien copiait 2 lignes à la seconde et j'ai 10000 lignes) Avec ceux-ci, j'obtiens le résultat en 5-6 secondes. Le dernier est effectivement un peu plus rapide que le premier.

Après quelques tests, j'ai remarqué par contre un petit problème. La commande copie toutes les lignes requises, sauf la première et la dernière ligne...

Pourrais-tu m'aider là-dessus s'il te plait?

Outre cela, superbe réponse, merci!
 

jessymathault

Nouveau membre
Pour faire apparaître la première ligne, je n'ai eu qu'à changer à la ligne 19 le 3 pour un 2.

19. For Lig = 2 To NbrLig

Reste à trouver pour faire apparaître la dernière ligne...
 

drul

Obscur pro du hardware
Staff
en ligne 28 essaye de mettre "numlig + 1"

Edit le deuxième code a surtout l'avantage d'être constant en vitesse. Avec le premier, si beaucoup de ligne sont vide, ils deviendra très lent.
 

jessymathault

Nouveau membre


Voilà, le document fonctionne parfaitement!

Merci beaucoup!
 

jessymathault

Nouveau membre


J'aimerais bien, mais je n'ai pas l'option "élire meilleure réponse" :/

 

drul

Obscur pro du hardware
Staff
Damn, faut qu'un modo la rajoute, mais je crains que zeb ou un autre modo ne soit pas la ces temps ... (en fait ça fait un bail que je n'ai pas vu d'autre modo que zeb par ici).

Si jamais c'est à la création du topic que peut choisir si tu veux ou non attribuer des points ...
 

drul

Obscur pro du hardware
Staff
:rofl:

En fait il y avait beaucoup plus simple...

Suffit d'utiliser la fonction union !
 

jessymathault

Nouveau membre


C'est à dire??
 

drul

Obscur pro du hardware
Staff
Regarde ici:

cette façon de faire serait parfaite pour ton programme.
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 098
Messages
6 717 055
Membres
1 586 282
Dernier membre
Yannick3553
Partager cette page
Haut