[résolu] Optimisation de code VBA

[grhum29]

Bonjour,

je vous sollicite une nouvelle fois car je suis confronté à un problème sur lequel je ne parviens pas à trouver de solution.

Le code ci-dessous est chargé de copier coller dans une autre feuille les lignes qui ont la colonne A vide puis de supprimer les lignes de la feuille d'origine ensuite :

j = 1
For i = 2 To 40
'de la deuxième ligne à la XXX

If Sheets("Feuil1").Cells(i, 1) = "" Then

Sheets("Feuil1").Select
Rows(i).Copy
Sheets("Feuil2").Select

Cells(j, 1).Select
ActiveSheet.Paste
j = j + 1
End If
Next i

Sheets("Feuil1").Select
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Le code fonctionne bien mais le problème est que le nombre de lignes de la feuille est variable car il s'agit d'un import d'un fichier CSV.
Dans le code actuel, la boucle va uniquement jusqu'à la ligne 40 mais il peut y en avoir X fois plus de lignes.

J'ai fait le test avec un fichier de 800 lignes en remplaçant

For i = 2 To 40

par

For i = 2 To 800

mais le problème est que le temps de traitement est long et qu'en plus je n'ai pas toujours le même nombre de lignes dans ma feuille1...

Ma question est donc de savoir comment je peux faire pour que ma boucle tienne compte du nombre de lignes dans ma feuille 1 qui est donc variable.

Est-il possible de modifier ce script pour qu'il s'exécute plus rapidement lorsqu'il y a beaucoup de lignes?

Merci de votre aide.

Bonne journée.

Grhum29

 

[DoubleZero]

Re : Optimisation de code VBA

Bonjour, grhum29, le Forum,

Comme ceci ?

Option Explicit
Sub Couper_coller()
    Dim c As Range
    Application.ScreenUpdating = False
    For Each c In Columns(1).SpecialCells(xlCellTypeBlanks)
        c.Offset(, 1).Resize(, 5).Copy Destination:=Sheets("Feuil2").Range("a" & Rows.Count).End(xlUp)(2)
    Next
    Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Application.ScreenUpdating = True
End Sub

A bientôt

 

[Jacou]

Re : Optimisation de code VBA

Bonjour grhum, bonjour le forum,
une autre solution en PJ.
Comme l'a fait Double Zero, pour augmenter la rapidité d'exécution de ta macro il faut mettre au début l'instruction

Application.ScreenUpdating = False

et à la fin

Application.ScreenUpdating = True

Bonne journée

 

[Paf]

Re : Optimisation de code VBA

Bonjour grhum29, DoubleZero, Jacou

une solution par tableau; +/- 1 seconde pour 2000 lignes

Sub Couper_coller()
 Dim TabDepart, Tab1(), Tab2(), i As Long, x As Long, y As Long

 With Worksheets("Feuil1")
 TabDepart = .Range("A2:F" & .Range("B" & .Rows.Count).End(xlUp).Row)

 For i = LBound(TabDepart) To UBound(TabDepart)
    If TabDepart(i, 1) = "" Then
        x = x + 1
        ReDim Preserve Tab2(1 To 6, 1 To x)
        For j = 2 To 6
            Tab2(j, x) = TabDepart(i, j)
        Next
    Else
        y = y + 1
        ReDim Preserve Tab1(1 To 6, 1 To y)
        For j = 1 To 6
            Tab1(j, y) = TabDepart(i, j)
        Next
    End If
 Next
 .Range("A2:F" & Range("B" & Rows.Count).End(xlUp).Row).ClearContents
 .Range("A2").Resize(UBound(Tab1, 2), 6) = Application.Transpose(Tab1)
 If x > 0 Then '
    With Worksheets("Feuil2")
    .Range("A2").Resize(UBound(Tab2, 2), 6) = Application.Transpose(Tab2)
    .Range("D2:F" & UBound(Tab2, 2) + 1).NumberFormat = "hh:mm"
    End With
 End If
 End With
End Sub

A+

 

[grhum29]

Re : Optimisation de code VBA

Bonsoir DoubleZero, Jacou et Paf,

Tout d'abord, merci pour vos réponses.

J'ai testé les 3 solutions et tout fonctionne très bien.

Merci de m'avoir aider.