Archiver des lignes d'un onglet à l'autre

Résolu
delouxange Messages postés 10 Statut Membre -  
delouxange Messages postés 10 Statut Membre -
Bonjour,

J'ai une macro qui est censée archiver des lignes de l'onglet "opportunities july 2012" à l'onglet "opportunities archives" et qui me retourne sans arrêt "script out of range".
Quelqu'un peut-il m'aider ?

Sub Archiver()

Sheets("Opportunities archives").Activate
j1 = Range("C21").CurrentRegion.Rows.Count
Sheets("Opportunities july 2012").Activate

colStatus = Range("Status").Column
colUpdate = Range("Update").Column
colAmount = Range("Opportunity_amount").Column
ligne = Range("Icidepart").Row

i = 1
k1 = 0
k2 = 0
k3 = 0
Do

'Archivage opportunities
If Month(Cells(ligne + i, colUpdate)) < Date And Cells(ligne + i, colStatus) = "Vente" Or Cells(ligne + i, colStatus) = "Abandon" Or Cells(ligne + i, colStatus) = "Perdu" Then
Sheets("Opportunities july 2012").Rows(ligne + i).Column("A:AL").Copy _
Destination:=Worksheets("Opportunities archives").Cells(j1 + k1 + 21, 1)
k1 = k1 + 1
Sheets("Opportunities july 2012").Rows(i + ligne).Delete
Else
i = i + 1
End If

Sheets("Opportunities july 2012").Activate

Loop While Not IsEmpty(Cells(ligne + i, colUpdate))

End Sub

12 réponses

  1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bonjour,

    script out of range
    Ca sent la boucle infinie à plein nez.
    Cependant, juste avec ton code, difficile de se rendre compte.
    Pourrais tu, stp, nous communiquer un classeur exemple avec tes données non confidentielles?
    Pour cela, utilises https://www.cjoint.com/
    0
  2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bon...
    Les noms de ta feuille "Opportunitties july 2012" dans ton code ne correspondent pas au nom de ta feuille. Le nom de ta feuille comporte un espace au bout.....
    Ensuite, la méthode de Copy ne fonctionne pas comme cela.
    Ne change pas les noms de tes feuilles et essaie ce code :
    Sub Archiver()
    
    Sheets("Opportunities archives").Activate
    j1 = Range("C21").CurrentRegion.Rows.Count
    Sheets("Opportunities july 2012 ").Activate
    
    colStatus = Range("Status").Column
    colUpdate = Range("Update").Column
    colAmount = Range("Opportunity_amount").Column
    ligne = Range("Icidepart").Row
    
    i = 1
    k1 = 0
    k2 = 0
    k3 = 0
    Do
    
        'Archivage opportunities
        If Month(Cells(ligne + i, colUpdate)) < Date And Cells(ligne + i, colStatus) = "Vente" Or Cells(ligne + i, colStatus) = "Abandon" Or Cells(ligne + i, colStatus) = "Perdu" Then
            Sheets("Opportunities july 2012 ").Range("A" & ligne + i & ":AL" & ligne + i).Copy _
            Destination:=Worksheets("Opportunities archives").Cells(j1 + k1 + 21, 1)
            k1 = k1 + 1
            Sheets("Opportunities july 2012 ").Rows(i + ligne).Delete
        Else
            i = i + 1
        End If
        
        Sheets("Opportunities july 2012 ").Activate
    
    Loop While Not IsEmpty(Cells(ligne + i, colUpdate))
    
    End Sub
    
    0
  3. delouxange Messages postés 10 Statut Membre
     
    la macro tourne, mais elle ne fait que supprimer, elle ne copie pas dans les archives !
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      il faudrait alors changer la ligne en gras... pour copier le bon range.
      Comme ceci peut être :
      Sub Archiver()  
      Sheets("Opportunities archives").Activate  
      j1 = Range("C21").CurrentRegion.Rows.Count  
      Sheets("Opportunities july 2012 ").Activate  
      colStatus = Range("Status").Column  
      colUpdate = Range("Update").Column  
      colAmount = Range("Opportunity_amount").Column  
      ligne = Range("Icidepart").Row  
      i = 1  
      k1 = 0  
      k2 = 0  
      k3 = 0  
      Do  
          'Archivage opportunities  
          If Month(Cells(ligne + i, colUpdate)) < Date And Cells(ligne + i, colStatus) = "Vente" Or Cells(ligne + i, colStatus) = "Abandon" Or Cells(ligne + i, colStatus) = "Perdu" Then  
              Sheets("Opportunities july 2012 ").Rows(i + ligne).Copy _  
              Destination:=Worksheets("Opportunities archives").Cells(j1 + k1 + 21, 1)  
              k1 = k1 + 1  
              Sheets("Opportunities july 2012 ").Rows(i + ligne).Delete  
          Else  
              i = i + 1  
          End If  
            
          Sheets("Opportunities july 2012 ").Activate  
      
      Loop While Not IsEmpty(Cells(ligne + i, colUpdate))  
      
      End Sub
      0
  4. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  5. delouxange Messages postés 10 Statut Membre
     
    Pijaku,

    la macro marche assez bien, merci encore. Cependant, dans la feuille Archives, elle copie toujours au même endroit, à partir de la ligne juste en dessous des entêtes... Pas moyen de lui faire copier alleurs.
    J'ai essayé de faire une macro "Activate cell" toute seule pour voir comment elle marche, et c'est pareil, elle sélectionne toujours la cellule en dessous des entêtes !
    Je te met le fichier au même endroit que précédemment, tu verras les 2 macros
    0
  6. delouxange Messages postés 10 Statut Membre
     
    Bon, j'ai fait des progrès par rapport à ce matin. j'ai trouvé la forme de petite macro qui fait ce que je veux. Et quand je la réutilise dans la grande, évidemment ça ne marche plus !! j'en peux plus, svp, aidez-moi !
    Il me retourne une erreur 400 sur la ligne Destination...

    Ci-dessous la petite macro (elle s'appelle copier ligne, ne faites pas attention) :

    Sub Copier_ligne()
    ' Copier_ligne Macro
    Sheets("Opportunities archives").Activate
    Range("c7").End(xlDown).Select
    j1 = ActiveCell.Row + 1
    Cells(j1, 1) = "Vu"

    End Sub

    Et la grande, qui me retourne une erreur :

    Sub Archiver()

    Sheets("Opportunities archives").Activate
    Range("c7").End(xlDown).Select
    j1 = ActiveCell.Row + 1
    Sheets("Opportunities july 2012").Activate

    colStatus = Range("Status").Column
    colUpdate = Range("Update").Column
    colAmount = Range("Opportunity_amount").Column
    ligne = Range("Icidepart").Row

    i = 1
    k1 = 0
    Do

    'Archivage opportunities
    If Month(Cells(ligne + i, colUpdate)) < Date And Cells(ligne + i, colStatus) = "Vente" Or Cells(ligne + i, colStatus) = "Abandon" Or Cells(ligne + i, colStatus) = "Perdu" Then
    Sheets("Opportunities july 2012").Rows(ligne + i).Copy _
    Destination:=Worksheets("Opportunities archives").Rows(j1 + k1)
    k1 = k1 + 1
    Sheets("Opportunities july 2012").Rows(i + ligne).Delete
    Else
    i = i + 1
    End If

    Sheets("Opportunities july 2012").Activate

    Loop While Not IsEmpty(Cells(ligne + i, colUpdate))

    End Sub
    0
  7. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bonjour,
    Dans ta destination, tu n'as pas besoin d'indiquer toute la ligne (Rows(machin)), mais l'adresse de la cellule en colonne A ou tu veux coller tes données :
    Destination:=Worksheets("Opportunities archives").Range("A" & j1 + k1)
    0
  8. delouxange Messages postés 10 Statut Membre
     
    Pijaku,
    Elle marche la macro chez toi ? Parce que pour moi, ça ne marche pas
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      elle ne marche pas ne signifie pas grand chose... Peux tu être plus précis?
      0
  9. delouxange Messages postés 10 Statut Membre
     
    est-ce que, sur ton fichier, la macro réalise ce qui est attendu ?
    la mienne ne marche pas, c'est à dire que le résultat n'est pas l'attendu. En fait, j'ai l'impression que tu n'essaies pas ce que tu me conseilles
    en l'occurence, elle ne se réalise pas car j'obtiens une erreur 400
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Bonjour,
      1- oui la macro réalise "ce qui est attendu". En même temps, "ce qui est attendu" n'a jamais vraiment été décris dans tes messages précédents.. Si si tu peux relire!

      2- la mienne ne marche pas, c'est à dire que le résultat n'est pas l'attendu
      Cf 1

      3- En fait, j'ai l'impression que tu n'essaies pas ce que tu me conseilles
      Je te retournes le compliment. N'oublies pas que je suis bénévole et j'essaie ce que je veux. Par contre, en tant que demandeur tu peux essayer ce que je te dis... Cf ici

      Mais bref laissons tomber cela et revenons à notre sujet.
      4- en l'occurence, elle ne se réalise pas car j'obtiens une erreur 400
      L'erreur 400 apparaît sur qu'elle ligne? Quel est exactement le message d'erreur?
      Parce que moi, quand j'essaye, en modifiant ta macro avec mes conseils trouvés dans ce fil de discussion, ça marche!
      Essaie ce code :
      Sub Archiver()
      colStatus = Range("Status").Column
      colUpdate = Range("Update").Column
      colAmount = Range("Opportunity_amount").Column
      ligne = Range("Icidepart").Row
      i = 1
      Do
          'Archivage opportunities
          If Month(Cells(ligne + i, colUpdate)) < Date And Cells(ligne + i, colStatus) = "Vente" Or Cells(ligne + i, colStatus) = "Abandon" Or Cells(ligne + i, colStatus) = "Perdu" Then
              Sheets("Opportunities july 2012").Rows(ligne + i).Copy Worksheets("Opportunities archives").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
              Sheets("Opportunities july 2012").Rows(i + ligne).Delete
          Else
              i = i + 1
          End If
      Loop While Not IsEmpty(Cells(ligne + i, colUpdate))
      End Sub
      0
  10. delouxange Messages postés 10 Statut Membre
     
    Bonjour Pijaku,

    ça y est, elle fonctionne !
    merci
    j'ai tout à fait conscience que tu es bénévole et j'ai essayé ce que tu m'as dit. C'est parce que cela ne fonctionnait pas chez moi que je t'ai posé la question

    bien contente que ça fonctionne, j'y ai passé 3h hier...
    je n'ai plus qu'à la transférer dans l'autre fichier avec les données confidentielles, en espérant qu'une erreur inattendue et sournoise n'apparaisse pas...
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      une erreur inattendue et sournoise n'apparaisse pas
      S jamais c'est le cas, reviens nous voir.
      A+
      0
  11. delouxange Messages postés 10 Statut Membre
     
    bon, ça n'a pas marché du 1er coup, le IF n'était pas tout à fait correct, mais c'est enfin réglé !!!
    merci pour ton aide
    0