Macro couper / coller en bas

Résolu/Fermé
Julien - 4 mars 2015 à 10:08
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 - 9 mars 2015 à 13:52
Bonjour,

A l'aide d'internet et de votre forum, j'ai réalisé une macro afin de couper certaines lignes de l'onglet "Data" dans l'onglet "BDD", uniquement si dans la quarantième colonne est inscrit "Terminé!". L'objectif étant d'archiver les lignes qui sont soldés dans un onglet différent.

La macro fonctionnait correctement et assez rapidement, mais je pense que le fait que le fichier contienne de plus en plus de lignes, cela ralenti la macro énormément...

A l'heure actuelle la macro prend trop de temps pour s'exécuter, quelqu'un a-t-il une solution ?

Sub Transfert()

reponse = MsgBox("Voulez-vous transférer les retours soldés ?", vbYesNo, "Transfert")
If reponse = vbYes Then

Application.ScreenUpdating = False

Dim iLI As Integer
Dim iRE As Integer
Dim LI As Worksheet
Dim re As Worksheet
Set LI = Worksheets("Data")
Set re = Worksheets("BDD")
iLI = 6
For iLI = 7 To 10000
If LI.Cells(iLI, 40).Text = "Terminé!" Then
LI.Range(iLI & ":" & iLI).Copy re.Cells(Rows.Count, 1).End(xlUp)(2)
LI.Range(iLI & ":" & iLI).Delete
iRE = iRE + 1
iLI = iLI - 1
End If
Next
Else
End If
Application.ScreenUpdating = True

End Sub


Merci

Julien

A voir également:

7 réponses

Bonjour
donne un model de ton fichier
car il manque des petit truc
A+
Maurice
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
4 mars 2015 à 15:46
Bonjour,

Je te propose de tester de cette façon pour laisser faire la boucle à excel et rester sur la plage utile.
Sub Transfert()
Dim reponse
Dim iLI As Integer
Dim iRE As Integer
Dim LI As Worksheet
Dim re As Worksheet
Dim elm As Range
    Application.ScreenUpdating = False
    reponse = MsgBox("Voulez-vous transférer les retours soldés ?", vbYesNo, "Transfert")
    If reponse = vbYes Then
        Set LI = Worksheets("Data")
        Set re = Worksheets("BDD")
        For Each elm In LI.UsedRange.Columns(40).Cells
            If elm.Text = "Terminé!" Then
                LI.Rows(elm.Row).Copy re.Cells(Rows.Count, 1).End(xlUp)(2)
            End If
        Next elm
    End If
    Application.ScreenUpdating = True
End Sub
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
4 mars 2015 à 21:01
PS : comme tu déplaces, il faut remplacer :
LI.Rows(elm.Row).Copy re.Cells(Rows.Count, 1).End(xlUp)(2)

par
LI.Rows(elm.Row).Cut re.Cells(Rows.Count, 1).End(xlUp)(2)
0
Julien > gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020
5 mars 2015 à 07:49
Bonjour,

Merci pour ton retour, je viens de tester et le temps d'exécution de la macro est toujours très long voir elle plante.

J'ai l'impression que c'est lié au fait que dans l'onglet "BDD" il y a environ 600 lignes et que c'est la copie à la dernière ligne qui rallonge la macro... mais je ne trouve pas de solution bis à la solution "End(xlUp)(2)" pour confirmer ou non.

Julien
0
Bonjour

sans ton fichier on ne peux pas savoir car tu a peux etre d'autre macro qui s'active ?
A+
Maurice
0
Oufiz Messages postés 11 Date d'inscription jeudi 5 mars 2015 Statut Membre Dernière intervention 9 mars 2015
5 mars 2015 à 14:29
Bonjour Maurice,

J'ai mis mon fichier sur Mediafire mais le forum supprime automatiquement le lien dès que je le poste je pense...
0
Oufiz Messages postés 11 Date d'inscription jeudi 5 mars 2015 Statut Membre Dernière intervention 9 mars 2015
5 mars 2015 à 14:30
www. mediafire. com/download/02b2a62jq8c81jk/Fichier+couper+coller.xlsm
0
Maurice > Oufiz Messages postés 11 Date d'inscription jeudi 5 mars 2015 Statut Membre Dernière intervention 9 mars 2015
5 mars 2015 à 15:34
Bonjour
ca marche pas
Ci-dessous La procédure

Pour transmettre un fichier, il faut passer par un site de pièce jointe tel que cjoint.com

Va sur ce site : http://cjoint.com
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse
0
Oufiz Messages postés 11 Date d'inscription jeudi 5 mars 2015 Statut Membre Dernière intervention 9 mars 2015
5 mars 2015 à 15:44
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
5 mars 2015 à 12:29
Bonjour,

Je me doutais bien que l'amélioration ne serait pas spectaculaire, alors en utilisant une autre technique cela devrait mieux aller :

Sub Transfert()
Dim reponse
Dim iLI As Long
Dim iRE As Long
Dim col As Long
Dim tLI(), tRE()
    Application.ScreenUpdating = False
    reponse = MsgBox("Voulez-vous transférer les retours soldés ?", vbYesNo, "Transfert")
    If reponse = vbYes Then
        tLI = Worksheets("Data").UsedRange.Cells.Value
        ReDim tRE(1 To UBound(tLI), 1 To UBound(tLI, 2))
        iRE = 1
        For iLI = 1 To UBound(tLI)
            If tLI(iLI, 40) = "Terminé!" Then
                For col = 1 To UBound(tLI, 2)
                    tRE(iRE, col) = tLI(iLI, col)
                Next col
                iRE = iRE + 1
            End If
        Next iLI
        With Worksheets("BDD")
            iLI = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(UBound(tLI), UBound(tLI, 2)).Value = tRE
        End With
        With Worksheets("Data")
            For iLI = UBound(tLI) To 1 Step -1
                If tLI(iLI, 40) = "Terminé!" Then .Rows(iLI).Delete
            Next iLI
        End With
    End If
    Application.ScreenUpdating = True
    MsgBox iRE - 1 & " lignes transférées"
End Sub
0
Oufiz Messages postés 11 Date d'inscription jeudi 5 mars 2015 Statut Membre Dernière intervention 9 mars 2015
6 mars 2015 à 09:10
Bonjour,

Malheureusement, idem que les solutions précédentes...

Je ne comprends pas pourquoi cela met autant de temps, il n'y a pas non plus tant de lignes que ça...

Julien
0

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

Posez votre question
Bonjour
une autre facon on desactive tout car tu a beaucoup de function
Sub Transfert()
Dim iLI As Integer
Dim NmbLig As Integer
Dim Lig As Integer
Dim Reponse As String

Reponse = MsgBox("Voulez-vous transférer les retours soldés ?", vbYesNo, "Transfert")
With Application
   .ScreenUpdating = False
   .EnableEvents = False
   .Calculation = xlManual
End With
   If Reponse = vbYes Then
       With Feuil2
'       With Worksheets("BDD")
          NmbLig = Cells(Rows.Count, 1).End(xlUp).Row
          Lig = .Cells(Rows.Count, 1).End(xlUp).Row + 1
          For iLI = NmbLig To 7 Step -1
             If Cells(iLI, 40).Text = "Terminé!" Then
                 Rows(iLI).Copy
                  .Cells(Lig, 1).PasteSpecial xlPasteValues
                 Rows(iLI).Delete
                 Lig = Lig + 1
             End If
         Next
      End With
   End If
With Application
   .CutCopyMode = False
   .ScreenUpdating = True
   .EnableEvents = True
   .Calculation = xlAutomatic
End With
MsgBox "Transfert Terminé"
End Sub


A+
Maurice
0
Oufiz Messages postés 11 Date d'inscription jeudi 5 mars 2015 Statut Membre Dernière intervention 9 mars 2015
6 mars 2015 à 09:04
Bonjour Maurice,

Je viens de tester, mais le résultat est le même.

Tu as réussi à l'exécuter sur le fichier correctement ?

Julien
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
6 mars 2015 à 09:49
Bonjour julien,

Pourtant, j'ai essayé sur le classeur que tu as posté et pour moi c'est pratiquement instantané : 2 secondes !

0
Oufiz Messages postés 11 Date d'inscription jeudi 5 mars 2015 Statut Membre Dernière intervention 9 mars 2015
6 mars 2015 à 10:43
gbinforme,

Je viens de test à nouveau ta dernière solution, idem que précédemment... Temps d'exécution beaucoup trop long.

J'ai donc retesté avec ta macro toujours mais en supprimant quasi toutes les lignes de l'onglet "BDD" et le transfert se fait en quelques secondes, une dizaine max.

Le problème pourrait-il venir du PC ?

Julien
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
6 mars 2015 à 12:17
en supprimant quasi toutes les lignes de l'onglet "BDD"
avec la dernière macro, cela n'a strictement aucune importance.
Le problème pourrait-il venir du PC ?
il a quelles particularités ? il est lent habituellement ?

J'ai rajouté la macro à ton classeur et l'ai affectée au bouton "archive" :
https://www.cjoint.com/c/ECgmzpwjoWd
Tu testes et tu me donnes le résultat, un peu plus de 2 secondes pour moi.
0
Oufiz Messages postés 11 Date d'inscription jeudi 5 mars 2015 Statut Membre Dernière intervention 9 mars 2015
6 mars 2015 à 14:09
J'ai testé sur 3 pc différents le fichier, la macro a pris un temps toujours très long, environ 5 à 10 min...

donc cela ne vient pas du PC.
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
6 mars 2015 à 14:55
environ 5 à 10 min...
Si tu l'avais fait avec le classeur ci-dessus tu aurais la durée exacte et non une pareille approximation : tu ne testes pas ce que je t'ai fourni !
0
Oufiz Messages postés 11 Date d'inscription jeudi 5 mars 2015 Statut Membre Dernière intervention 9 mars 2015
6 mars 2015 à 17:44


J'avais pas attendu la fin de la macro quand j'ai testé sur mon PC, c'est en testant sur le pc d'un collègue que celui-ci m'a dit que ça avait duré plus ou mois 5 à 10 min..
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
6 mars 2015 à 21:36
Bonjour,

Je suppose que vous utilisez 2010/2013 ?
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
8 mars 2015 à 11:55
Bonjour,

Le problème venait d'excel 2010/2013 qui rame pour supprimer les lignes alors que sur 2007 il n'y a pas le problème.

Une version qui devrait être plus rapide à tester :

https://www.cjoint.com/c/ECimbs3Z2kz
0
Oufiz Messages postés 11 Date d'inscription jeudi 5 mars 2015 Statut Membre Dernière intervention 9 mars 2015
8 mars 2015 à 22:28
Bonjour,

Le transfert a fonctionné en moins d'une seconde, donc parfait, merci pour l'aide.

Seul problème, toute les formules de l'onglet "Data" ont été copier coller en valeur, est-ce possible de corriger ?

J'ai regardé pour modifier, mais je vois pas trop comment... maybe ligne 37 de la macro ?!

Julien
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
8 mars 2015 à 23:09
Bonsoir,

Effectivement, je l'avais fait en valeur et je ne voyait pas pour les formats mais cela devrait aller correctement maintenant :

https://www.cjoint.com/c/ECixrHaiKzf

Peux-tu me confirmer ta version excel ?
0
Oufiz Messages postés 11 Date d'inscription jeudi 5 mars 2015 Statut Membre Dernière intervention 9 mars 2015
9 mars 2015 à 08:13
Bonjour,

J'ai Excel 2010.

J'ai toujours le même soucis avec le 2ème fichier, les formules sont en valeurs, tu as mis le bon ?

Julien
0