Temps d'exécution beaucoup trop long

Bonjour tout le monde

Je suis assez débutante en VBA et je dois créer une macro toute simple.

En effet, il faut que je récupère dans une feuille excel toutes les lignes correspondant à une certaine personne (cette personne est renseignée dans la colonne G) afin de les coller dans de nouvelles feuilles suivant le nom de la personne (je sais pas si c'est très clair)

Cependant, le temps d'exécution prend 10 à 20 min si excel ne plante pas avant... J'ai essayé différentes choses comme arrêter les maj de l'écran etc.. mais rien n'y fait

C'est peut-être un problème tout bête dans l'utilisation des tableaux mais là je vois pas...

Ma feuille "source" possède 500 lignes et une vingtaine de colonnes

Je vous mets mon code, merci du temps que vous prendrez pour me répondre

Option Explicit
Dim i As Integer, j As Integer, p As Integer, w As Integer, ligne As Integer
Dim tab2(500, 500)

Sub Suivi_Commandes_Client()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Sheets.Add
ActiveSheet.Name = "Ca"
Sheets.Add
ActiveSheet.Name = "Cb"
Sheets.Add
ActiveSheet.Name = "Sa"
Sheets.Add
ActiveSheet.Name = "LSP"

For i = 1 To 500
    For p = 2 To 500
        If Sheets("201701_suivis_cdecli").Range("G" & i).Value = "NOMA      " Then
            For j = 1 To 25
                tab2(p, j) = Sheets("201701_suivis_cdecli").Cells(i, j).EntireRow.Value
                Sheets("Ca").Cells(p, j).EntireRow.Value = tab2(p, j)
            Next
        ElseIf Sheets("201701_suivis_cdecli").Range("G" & i).Value = "NOMB   " Or Sheets("201701_suivis_cdecli").Range("G" & i).Value = "NOMC     " Or Sheets("201701_suivis_cdecli").Range("G" & i).Value = "NOMD      " Then
            For j = 1 To 25
                tab2(p, j) = Sheets("201701_suivis_cdecli").Cells(i, j).EntireRow.Value
                Sheets("Cb").Cells(p, j).EntireRow.Value = tab2(p, j)
            Next
        ElseIf Sheets("201701_suivis_cdecli").Range("G" & i).Value = "NOME      " Or Sheets("201701_suivis_cdecli").Range("G" & i).Value = "NOMF      " Or Sheets("201701_suivis_cdecli").Range("G" & i).Value = "NOMG    " Or Sheets("201701_suivis_cdecli").Range("G" & i).Value = "NOMH    " Then
            For j = 1 To 25
                tab2(p, j) = Sheets("201701_suivis_cdecli").Cells(i, j).EntireRow.Value
                Sheets("Sa").Cells(p, j).EntireRow.Value = tab2(p, j)
            Next
        ElseIf Sheets("201701_suivis_cdecli").Range("G" & i).Value = "NOMI        " Then
            For j = 1 To 25
                tab2(p, j) = Sheets("201701_suivis_cdecli").Cells(i, j).EntireRow.Value
                Sheets("LSP").Cells(p, j).EntireRow.Value = tab2(p, j)
            Next
        End If
        i = i + 1
    Next
Next

Sheets("Ca").Range("A1:A65536").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Sheets("Ca").Range("A1:Z1").Value = Sheets("201701_suivis_cdecli").Range("A1:Z1").Value
Sheets("Ca").Columns("A:D").Delete
Sheets("Ca").Columns("C:E").Delete
Sheets("Ca").Columns("D:M").Delete
Sheets("Ca").Range("D1").Value = "En cours/A solder"

Sheets("Cb").Range("A1:A65536").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Sheets("Cb").Range("A1:Z1").Value = Sheets("201701_suivis_cdecli").Range("A1:Z1").Value
Sheets("Cb").Columns("A:D").Delete
Sheets("Cb").Columns("C:E").Delete
Sheets("Cb").Columns("D:M").Delete
Sheets("Cb").Range("D1").Value = "En cours/A solder"

Sheets("Sa").Range("A1:A65536").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Sheets("Sa").Range("A1:Z1").Value = Sheets("201701_suivis_cdecli").Range("A1:Z1").Value
Sheets("Sa").Columns("A:D").Delete
Sheets("Sa").Columns("C:E").Delete
Sheets("Sa").Columns("D:M").Delete
Sheets("Sa").Range("D1").Value = "En cours/A solder"

Sheets("LSP").Range("A1:A65536").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Sheets("LSP").Range("A1:Z1").Value = Sheets("201701_suivis_cdecli").Range("A1:Z1").Value
Sheets("LSP").Columns("A:D").Delete
Sheets("LSP").Columns("C:E").Delete
Sheets("LSP").Columns("D:M").Delete
Sheets("LSP").Range("D1").Value = "En cours/A solder"

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub

Bonjour,

Tu peux mettre une copie anonymisée de ton fichier? la macro exécute un nombre d'itérations très grand. Il faut voir s'il y a pas moyen d'y remédier

Ooooh my God !

nono78 a écrit :

Bonjour,

Tu peux mettre une copie anonymisée de ton fichier? la macro exécute un nombre d'itérations très grand. Il faut voir s'il y a pas moyen d'y remédier

Approuvé !

A+

Bonsoir,

Hum... Dans le brouillard... C'est de saison ! Je t'ai quand même fait un essai (en pièce jointe) de ce que j'ai compris dans ton fouillis...

(25 ou 26 colonnes c'était pas évident ? Dans le doute j'en ai mis 26 !)

A+

[EDIT] Pièce jointe supprimée version boguée... voire plus loin !

Bonjour Auriane, Galopin,

un autre essai, sans fichier réel, à partir de ce que j'ai compris!

La macro démarre en cliquant sur la cellule [A1].

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim wks1, wks2 As Worksheet
Dim tCells, tTab(8)
'
If Target.Address = [A1].Address Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    '
    Set wks1 = Worksheets("201701_suivis_cdecli")
    tCells = Array("A", "E", "F", "J", "U", "V", "W", "X", "Y")
    For x = 1 To 4
        sFlag = Choose(x, "Ca", "Cb", "Sa", "LSP")
        iFlag = 0
        For Each wks2 In Worksheets
            If wks2.Name = sFlag Then iFlag = 1
        Next
        If iFlag = 0 Then
            Sheets.Add
            ActiveSheet.Name = sFlag
            For y = 0 To UBound(tCells)
                Worksheets(sFlag).Cells(1, y + 1) = wks1.Range(CStr(tCells(y)) & 1).Value
            Next
            Worksheets(sFlag).Range("D1").Value = "En cours/A solder"
        End If
    Next
    '
    For x = 2 To wks1.Range("A" & Rows.Count).End(xlUp).Row
        sFlag = wks1.Cells(x, 7)
        iFlag = 0
        iFlag = Switch(sFlag = "NOMA", 1, sFlag = "NOMB", 2, sFlag = "NOMC", 2, sFlag = "NOMD", 2, sFlag = "NOME", 3, sFlag = "NOMF", 3, sFlag = "NOMG", 3, sFlag = "NOMH", 3, sFlag = "NOMI", 4)
        If iFlag > 0 Then
            Set wks2 = Choose(iFlag, Worksheets("Ca"), Worksheets("Cb"), Worksheets("Sa"), Worksheets("LSP"))
            iLig = wks2.Range("A" & Rows.Count).End(xlUp).Row + 1
            For y = 0 To UBound(tCells)
                tTab(y) = Range(CStr(tCells(y)) & x).Value
            Next
            wks2.Range("A" & iLig).Resize(, 9).Value = tTab
        End If
    Next
    '
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End If
'
End Sub

A+

@Galopin : grâce à ton code, j'ai compris l'effet pervers des effacements de colonnes tels qu'opérés par Auriane.

Très subtile et fine observation de ta part!

Cela m'a permis, au-delà de la correction, d'explorer d'autres facettes de VBA!

Merci!

Pff... L'est pourri ma soluce !

Tu coup en comparant avec celle de Curulis on trouve pas le même résultat... mais tu as un problème de colonnage.

Compris c'est juste la ligne 1 qui fout le b....

Version corrigée !

A+

Bonjour galopin, bonjour curulis,

Je m'excuse pour la non compréhensibilité de mon message

Cependant vous avez tout à fait compris où je voulais en venir et je vous en remercie

D'ailleurs galopin ta solution est parfaite et j'ai tout compris!

Curulis, ta solution est très bien mais je préfère celle de galopin qui m'est quand même vachement plus accessible je trouve..

Et je suis désolée pour mes lacunes au niveau des tableaux mais le VBA n'est pas forcément mon domaine de prédilection ^^

En tout cas, je vous remercie énormément, vous m'avez enlevé une sacrée épine du pieds puis j'ai pu apprendre de nouvelles choses!

Merci beaucoup!

Bonjour,

Non, Non pas parfaite la V1 (il y a un problème de première ligne)

Il faut prendre la V2...

Sinon la version de Curulis est pas mal non plus !

A+