Enregistrer une plage de donnée d'une feuille excel à une autre Fermé

Question

Bonjour, 
je suis un debutant dans la programmaton vba...
jai essayé d'ecrir un programme pour la gestion de mes factures. où la feuil1 permet d'éditionner la facture, dont la plage  Range("A1:D23") doit s'enregistrer a la suite d'un enregistrement antérieur  dans la feuil2 du même classeur. d’ici la j'ai réussi à écrire un code très long qui marche bien mais met beaucoup de temps pour s’exécuter; le voici:

Private Sub CommandButton1_Click()
Dim dl As Long, i As Long
If MsgBox("Voulez-vous Sauvegarder la facture?", vbYesNo, "confirmation") = vbYes Then
    dl = Sheets("mouvements").Range("e456541").End(xlUp).Row + 1
    For i = dl To dl + 10
                Sheets("mouvements").Cells(i, 1) = Range("k6").Value
                Sheets("mouvements").Cells(i, 3) = Range("h7").Value
                Sheets("mouvements").Cells(i, 4) = Range("h6").Value
                Sheets("mouvements").Cells(dl, 5) = Range("h13").Value
                Sheets("mouvements").Cells(dl + 1, 5) = Range("h14").Value
                Sheets("mouvements").Cells(dl + 2, 5) = Range("h15").Value
                Sheets("mouvements").Cells(dl + 3, 5) = Range("h16").Value
                Sheets("mouvements").Cells(dl + 4, 5) = Range("h17").Value
                Sheets("mouvements").Cells(dl + 5, 5) = Range("h18").Value
                Sheets("mouvements").Cells(dl + 6, 5) = Range("h19").Value
                Sheets("mouvements").Cells(dl + 7, 5) = Range("h20").Value
                Sheets("mouvements").Cells(dl + 8, 5) = Range("h21").Value
                Sheets("mouvements").Cells(dl + 9, 5) = Range("h22").Value
                Sheets("mouvements").Cells(dl + 10, 5) = Range("h23").Value
                Sheets("mouvements").Cells(dl, 7) = Range("g13").Value
                Sheets("mouvements").Cells(dl + 1, 7) = Range("g14").Value
                Sheets("mouvements").Cells(dl + 2, 7) = Range("g15").Value
                Sheets("mouvements").Cells(dl + 3, 7) = Range("g16").Value
                Sheets("mouvements").Cells(dl + 4, 7) = Range("g17").Value
                Sheets("mouvements").Cells(dl + 5, 7) = Range("g18").Value
                Sheets("mouvements").Cells(dl + 6, 7) = Range("g19").Value
                Sheets("mouvements").Cells(dl + 7, 7) = Range("g20").Value
                Sheets("mouvements").Cells(dl + 8, 7) = Range("g21").Value
                Sheets("mouvements").Cells(dl + 9, 7) = Range("g22").Value
                Sheets("mouvements").Cells(dl + 10, 7) = Range("g23").Value
                Sheets("mouvements").Cells(dl, 8) = Range("j13").Value
                Sheets("mouvements").Cells(dl + 1, 8) = Range("j14").Value
                Sheets("mouvements").Cells(dl + 2, 8) = Range("j15").Value
                Sheets("mouvements").Cells(dl + 3, 8) = Range("j16").Value
                Sheets("mouvements").Cells(dl + 4, 8) = Range("j17").Value
                Sheets("mouvements").Cells(dl + 5, 8) = Range("j18").Value
                Sheets("mouvements").Cells(dl + 6, 8) = Range("j19").Value
                Sheets("mouvements").Cells(dl + 7, 8) = Range("j20").Value
                Sheets("mouvements").Cells(dl + 8, 8) = Range("j21").Value
                Sheets("mouvements").Cells(dl + 9, 8) = Range("j22").Value
                Sheets("mouvements").Cells(dl + 10, 8) = Range("j23").Value
                
     Next i
End If
MsgBox "sauvegarde Réussie", vbInformation, "Confirmation Sauvegarde"
End Sub

Aidez moi a réduir ce code et a réduire son temps d'éxecution.merci


Configuration: Windows 7 / Firefox 43.0

Frenchie83 · Answer

Bonjour
Pour que votre code soit plus rapide, ajoutez en première ligne
Application.ScreenUpdating = False
La boucle" For i = dl To dl + 10" hormis les 3 premières colonnes, recopie 10 fois les valeurs des colonnes I G et H au même endroit (donc inutile). 
Next i devrait se trouver après la 3ème ligne
        For i = dl To dl + 10
            Sheets("mouvements").Cells(i, 1) = Range("k6").Value
            Sheets("mouvements").Cells(i, 3) = Range("h7").Value
            Sheets("mouvements").Cells(i, 4) = Range("h6").Value
         Next i

Vous pouvez écrire le code sous cette forme. A coller dans un module classique pas celui de la feuille (dans la fenêtre VBA, faire insertion- module)
Sub Recopie()
    Dim dl As Long, i As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("mouvements")
    If MsgBox("Voulez-vous Sauvegarder la facture?", vbYesNo, "confirmation") = vbYes Then
        f2.Select
        dl = [E456541].End(xlUp).Row + 1
        Range(Cells(dl, 1), Cells(dl + 10, 1)) = f1.[k6]
        Range(Cells(dl, 3), Cells(dl + 10, 3)) = f1.[H7]
        Range(Cells(dl, 4), Cells(dl + 10, 4)) = f1.[H6]
        Range(Cells(dl, 5), Cells(dl + 10, 5)) = f1.[h13:h23].Value
        Range(Cells(dl, 7), Cells(dl + 10, 7)) = f1.[g13:g23].Value
        Range(Cells(dl, 8), Cells(dl + 10, 8)) = f1.[j13:j23].Value
        MsgBox "sauvegarde Réussie", vbInformation, "Confirmation Sauvegarde"
    End If
    f1.Select
End Sub
remplacez "Feuil1" par le nom de votre feuille contenant les données à récupérer. 
Dans le module de la feuille, remplacez votre code par
Private Sub CommandButton1_Click()
   Recopie
End Sub
Cdlt

Enregistrer une plage de donnée d'une feuille excel à une autre

1 réponse

Discussions similaires

Newsletters