Excel macro copier ligne

outch -  
gbinforme Messages postés 15481 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,

J'ai un classeur excel dans mon service qui permet de suivre les réceptions à venir et cellles déjà faites, tout cela dans deux onglets Réceptions et Archives.

Mon but est que lorsqu'une personne remplie une cellule (qui correspond au bon de réception ex: BR021225) dans l'onglet réception, toute la ligne avec la ref article, la date de commande etc aille se coller en fin de tableau sur l'onglet archive.

Pour l'instant j'ai ça 

Sub FiltreOutch()

  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
  
  Sheets("Archives").Activate ' feuille de destination
  
  Col = "J"                 ' colonne de la donnée non vide à tester
  NumLig = 0
  With Sheets("Receptions")     ' feuille source
  NbrLig = .Cells(65536, Col).End(xlUp).Row
  For Lig = 1 To NbrLig
    If .Cells(Lig, Col).Value <> "" Then
      .Cells(Lig, Col).EntireRow.Cut
      NumLig = NumLig + 1
      Cells(NumLig, 1).Select
      ActiveSheet.Paste
    End If
  Next
  End With
    
End Sub


Ca fonctionne mais j'ai les problèmes suivant :

La ligne avec le titre est systématiquement coupée et collée => n'y a t'il pas un moyen pour l'ignorer ds la macro ? En fait elle detecte les cellules "remplies" et les collent et bien sûr la colonne avec le titre est reconnue comme "pleine" et donc coupée/collée.
Les lignes coupées laissent un espace vide dans le tableau => n'y a t'il pas moyen de supprimer les lignes vides.
J'aimerais aussi executer cette macro avec un bouton "archiver"

J'espere que j'ai été précis, je m'y connais peu en vba donc merci de votre aide.

Cordialement

Outch
A voir également:

8 réponses

Réponse 1 / 8
guy2mars Messages postés 210 Statut Membre 71
 
.Cells(Lig, Col).EntireRow.Cut
tu peux remplacer cut par copy
0
Réponse 2 / 8
gbinforme Messages postés 15481 Date d'inscription   Statut Contributeur Dernière intervention   4 730
 
bonjour

Si tu commences ta boucle à 2 tu résous ton titre : 
For Lig = 2 To NbrLig

Si tu rajoutes cette ligne après la copie tu ne devrais plus avoir tes lignes vides 
      .Cells(Lig, Col).EntireRow.delete
0
Réponse 3 / 8
guy2mars Messages postés 210 Statut Membre 71
 
excuses, j avais mal lu le pb, je pensais que tu ralais parce que c'etait coupé.
...
gbinforme t a repondu
0
outch
 
Ok merci,

J'ai réussi à gérer le problème du titre, mais pour la suppression des lignes vides j'ai un souci

voici le code 

Sub FiltreOutch()

  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
  
  Sheets("Archives").Activate ' feuille de destination
  
  Col = "J"                 ' colonne de la donnée non vide à tester
  NumLig = 0
  With Sheets("Receptions")     ' feuille source
  NbrLig = .Cells(65536, Col).End(xlUp).Row
  For Lig = 2 To NbrLig     ' commence boucle à 2
      If .Cells(Lig, Col).Value <> "" Then
      .Cells(Lig, Col).EntireRow.Cut
      NumLig = NumLig + 1
      Cells(NumLig, 1).Select
      ActiveSheet.Paste
      .Cells(Lig, Col).EntireRow.Delete
    End If
  Next
  End With
End Sub


Le souci c'est que ça ne colle que la moitié de mes lignes et quand je relance la macro ça me supprime une ligne dans l'onglet des réceptions, enfin ça me coupe ma ligne sans la coller dans la partie archive quoi...

Une aide ?

Merci d'avance
0
Réponse 4 / 8
guy2mars Messages postés 210 Statut Membre 71
 
re

pour repondre a ton pb, je ferais un truc comme ca

Dim i As Integer, valeur As String
i = 1
Do While i < 56000
valeur = Range("J" & i).Value
If valeur = "" Then
Rows(i & ":" & i).Delete
i=i-1 '(pour relire la ligne si y'en a 2 consecutives vides)
End If
i = i + 1
Loop
End Sub
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 8
gbinforme Messages postés 15481 Date d'inscription   Statut Contributeur Dernière intervention   4 730
 
bonjour


Le souci c'est que ça ne colle que la moitié de mes lignes

Lorsque tu supprime des lignes, il faut commencer en bas : 
 For Lig = NbrLig  To   2 step -1  ' termine boucle à 2
0
outch
 
Merci gbinform j'ai pris ta solution.

En revanche tu pourrais m'aider à coller la ligne à la suite des lignes de la partie archive. Avec ce script ellles se collent à la place de la première ligne

mon code 

Sub FiltreOutch()

  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
  
  Sheets("Archives").Activate ' feuille de destination
  
  Col = "J"                 ' colonne de la donnée non vide à tester
  NumLig = 0
  With Sheets("Receptions")     ' feuille source
  NbrLig = .Cells(65536, Col).End(xlUp).Row
   For Lig = NbrLig To 2 Step -1     ' termine boucle à 2
      If .Cells(Lig, Col).Value <> "" Then
      .Cells(Lig, Col).EntireRow.Cut
      NumLig = NumLig + 1
      Cells(NumLig, 1).Select
      ActiveSheet.Paste
      .Cells(Lig, Col).EntireRow.Delete
    End If
  Next
  End With
End Sub


Encore merci
0
Réponse 6 / 8
gbinforme Messages postés 15481 Date d'inscription   Statut Contributeur Dernière intervention   4 730
 
bonjour

Tu peux le faire ainsi en utilisant la fonction de dernière ligne utilisée par une cellule documentée : 
Sub FiltreOutch()

  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  
  Sheets("Archives").Activate ' feuille de destination
  
  Col = "J"                 ' colonne de la donnée non vide à tester
  With Sheets("Receptions")     ' feuille source
  NbrLig = .Cells(65536, Col).End(xlUp).Row
   For Lig = NbrLig To 2 Step -1     ' termine boucle à 2
      If .Cells(Lig, Col).Value <> "" Then
      .Cells(Lig, Col).EntireRow.Cut _
      Destination:=Cells(Cells.SpecialCells(xlCellTypeLastCell).Row + 1, 1)
      .Cells(Lig, Col).EntireRow.Delete
    End If
  Next
  End With
End Sub
0
Réponse 7 / 8
Utilisateur anonyme
 
Bonjour à tous,

Je me suis aussi heurté à ce genre de situation, alors je vous fais part d'une observation
qui m'apparait importante.

Cette instruction :
NbrLig = .Cells(65536, Col).End(xlUp).Row
informe sur le nombre de ligne !

Et cette instruction diminue le nombre de ligne
.Cells(Lig, Col).EntireRow.Delete

donc NbrLig devrait être décrémenté en plus de la décrémentation automatique de la boucle !
NbrLig = (NbrLig - 1)

Est-ce que je me fais comprendre ?

Lupin

p.s. gbinforme, nous avons du temps relativement doux dans mon coin de pays, j'espère
que Dame nature est aussi clémente pour vous :-)
0
Réponse 8 / 8
gbinforme Messages postés 15481 Date d'inscription   Statut Contributeur Dernière intervention   4 730
 
bonjour Lupin.A,

Effectivement je vois que le climat du nouveau monde n'est pas fidèle à sa réputation et en France nous sommes loin du réchauffement climatique avec un hiver comme dans les cartes postales.

donc NbrLig devrait être décrémenté en plus de la décrémentation automatique de la boucle !
NbrLig = (NbrLig - 1)

Décrémenter ne va servir à rien car la variable n'est utilisée que comme point de départ et on aurait pu s'en passer en écrivant : 
   For Lig = .Cells(65536, Col).End(xlUp).Row To 2 Step -1     ' termine boucle à 2

Effectivement, lorsque l'on fait une boucle de suppression, il vaut mieux commencer par le bas car sinon il faut à la fois faire varier la borne et l'indice utilisé dans la boucle ce qui n'est jamais simple à maitriser.
0