Simplification pour rapidité

Bonjour à toutes et à tous,

Joyeuses fêtes

pour quelqu'un qui aurait une idée pour simplifier la macro suivante ( ca crée une lenteur quand on des feuilles de 3000 lignes )

merci d'avance

Private Sub CommandButton3_Click()
InitVar
Tbl
        derligV = v.Cells(Rows.Count, 1).End(xlUp).Row ' dernière ligne occupée
        derligC = C.Cells(Rows.Count, 1).End(xlUp).Row  ' dernière ligne occupée
        derligP = P.Cells(Rows.Count, 1).End(xlUp).Row  ' dernière ligne occupée
        derligCH = CH.Cells(Rows.Count, 1).End(xlUp).Row  ' dernière ligne occupée

        For l = 1 To lg ' boucle sur les lignes du tableau
            v.Range("A" & derligV + l) = t(l, 1)
            v.Range("B" & derligV + l) = t(l, 2)
            v.Range("C" & derligV + l) = t(l, 3)
            v.Range("D" & derligV + l) = t(l, 4)
            v.Range("E" & derligV + l) = t(l, 5)
            v.Range("F" & derligV + l) = t(l, 6)
            v.Range("G" & derligV + l) = t(l, 7)
            v.Range("H" & derligV + l) = t(l, 8)
            v.Range("I" & derligV + l) = t(l, 9)
            v.Range("j" & derligV + l) = t(l, 10)
            v.Range("k" & derligV + l) = t(l, 11)
         Next l

          For l = 1 To lg
            If t(l, 5) <> Empty Then
            C.Range("A" & derligC + l) = t(l, 1)
            C.Range("B" & derligC + l) = t(l, 2)
            C.Range("C" & derligC + l) = t(l, 3)
            C.Range("D" & derligC + l) = t(l, 4)
            C.Range("E" & derligC + l) = t(l, 5)
            C.Range("F" & derligC + l) = t(l, 6)
            C.Range("G" & derligC + l) = t(l, 7)
            C.Range("H" & derligC + l) = t(l, 8)
            C.Range("I" & derligC + l) = t(l, 11)
            End If
          Next l

        For l = 1 To lg
            If t(l, 9) <> Empty Then
            P.Range("A" & derligP + l) = t(l, 1)
            P.Range("B" & derligP + l) = t(l, 2)
            P.Range("C" & derligP + l) = t(l, 3)
            P.Range("D" & derligP + l) = t(l, 4)
            P.Range("E" & derligP + l) = t(l, 9)
            P.Range("F" & derligP + l) = t(l, 11)
            End If
        Next l

        For l = 1 To lg
            If t(l, 10) <> Empty Then
            CH.Range("A" & derligCH + l) = t(l, 1)
            CH.Range("B" & derligCH + l) = t(l, 2)
            CH.Range("C" & derligCH + l) = t(l, 3)
            CH.Range("D" & derligCH + l) = t(l, 4)
            CH.Range("E" & derligCH + l) = t(l, 10)
            CH.Range("F" & derligCH + l) = t(l, 11)
            End If
        Next l

    Me.ListView1.ListItems.Clear
    On Error Resume Next
    C.[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    P.[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    CH.[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete

    UserForm_Initialize
End Sub

en sachant que le tableau est comme suit

Private Sub Tbl()
With UserForm1.ListView1
        lg = .ListItems.Count
        cl = .ColumnHeaders.Count
        ReDim t(1 To lg, 1 To cl + 1)
        For l = 1 To lg
            t(l, 1) = .ListItems(l).Text
            For m = 1 To cl - 1
                t(l, m + 1) = .ListItems(l).ListSubItems(m).Text
            Next m
        Next l
 End With
End Sub

Bonjour,

Ajoutez "Application.ScreenUpdating = False" en début de macro

ensuite vous pouvez essayer de simplifier sous cette forme:

    For l = 1 To lg ' boucle sur les lignes du tableau
        Range(v.Cells(derligV + l, "A"), v.Cells(derligV + l, "K")).Value = Array(t(l, 2), t(l, 3), t(l, 4), t(l, 1), t(l, 5), t(l, 6), t(l, 7), t(l, 8), t(l, 9), t(l, 10), t(l, 11))
    Next l

Cdlt

bonjour,

edit hello Arturo83

à tester

'(...)

derligV = V.Cells(Rows.Count, 1).End(xlUp).Row ' dernière ligne occupée
derligC = C.Cells(Rows.Count, 1).End(xlUp).Row ' dernière ligne occupée
derligP = P.Cells(Rows.Count, 1).End(xlUp).Row ' dernière ligne occupée
derligCH = CH.Cells(Rows.Count, 1).End(xlUp).Row ' dernière ligne occupée

V.Range("A" & derligV + 1).Resize(lg, 11) = t

C.Range("A" & derligC + 1).Resize(lg, 11) = t
Columns("I:J").Delete shift:=xlToLeft

P.Range("A" & derligP + 1).Resize(lg, 11) = t
Columns("I:J").Delete shift:=xlToLeft
Columns("E:G").Delete shift:=xlToLeft

CH.Range("A" & derligCH + 1).Resize(lg, 11) = t
Columns("E:H").Delete shift:=xlToLeft

'(...)

bonjour à Arturo 83 et à h2so4

pour Arturo83, ca me donne dub ou fonction non défini ( en sachant que même en ayant arrangé la formule en

Array(t(l, 1), t(l, 2), t(l, 3), t(l, 4), t(l, 5), t(l, 6), t(l, 7), t(l, 8), t(l, 9), t(l, 10), t(l, 11))

pour h2so4, ca me donne variable non défini t???

je joint le fichier comme meme

pardon à vous 2 , les 2 facons fonctionne!!!! et je vous remercie

il y avait la variable t as varianté en 'Dim t as variant !!! je ne sait comment j'ai fait ca

en tous les cas merci beaucoup pour tous