High-Tech Santé Médecine Droit-Finances

Réalisation

vidéo numérique

Rechercher : dans
Par :

Excel macro copier ligne

Dernière réponse le 18 fév 2009 à 08:22:27 outch, le 16 fév 2009 à 22:19:38 
 Signaler ce message aux modérateurs

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
Configuration: Windows Vista
Internet Explorer 7.0

Meilleures réponses pour « Excel macro copier ligne » dans :
Figer une ligne dans un tableau Excel VoirPour figer la ligne 1 (par exemple) dans une feuille excel : Sélectionnez la ligne 2, Puis allez dans le menu "Fenêtres" et option "Figer les volets".
Télécharger Excel Sheets Copier Voir
Télécharger MOREFUNC (Macro complémentaire EXCEL) VoirMorefunc est une macro complémentaire proposant 67 nouvelles fonctions de feuille de calcul pour Excel. Ces fonctions sont compatibles avec Excel 95 à 2007. Elles ne sont pas portables sur d'autres plate-formes que Windows, ni sur d'autres...
Posez votre question Répondre

1

guy2mars, le 16 fév 2009 à 22:52:08

.Cells(Lig, Col).EntireRow.Cut
tu peux remplacer cut par copy

   
Répondre à guy2mars

2

gbinforme, le 16 fév 2009 à 22:52:22

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

Toujours zen

   
Répondre à gbinforme

3

guy2mars, le 16 fév 2009 à 22:54:35

Excuses, j avais mal lu le pb, je pensais que tu ralais parce que c'etait coupé.
...
gbinforme t a repondu

   
Répondre à guy2mars

4

outch, le 16 fév 2009 à 23:26:46

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

   
Répondre à outch

5

guy2mars, le 16 fév 2009 à 23:50:11

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

   
Répondre à guy2mars

6

gbinforme, le 17 fév 2009 à 08:34:30

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

Toujours zen

   
Répondre à gbinforme

7

outch, le 17 fév 2009 à 19:48:09

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

   
Répondre à outch

8

gbinforme, le 17 fév 2009 à 21:30:43

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

Toujours zen

   
Répondre à gbinforme

9

Lupin.A, le 17 fév 2009 à 23:01:29

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 :-)

   
Répondre à Lupin.A

10

 gbinforme, le 18 fév 2009 à 08:22:27

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.
Toujours zen

   
Répondre à gbinforme
Posez votre question Répondre
Ils ont besoin de votre aide