Autres Problème de compréhension macro

[JPaul13]

Bonjour à Tous les membres du club

Comme évoqué hier en fin cette nuit je suis nouveau et je vais vous présenter un problème que je souhaiterai résoudre et sur lequel je but depuis plusieurs semaines.
Actuellement mon code fonctionne très bien ; il s'agit de transférer les données d'une feuille excel du même classeur vers ma listview de mon USERFORM mode plein écran.
Le soucis est que lorsque je transfert plus 5000 lignes sur 15 colonnes j'ai un ralentissement ce qui est très gênant au visuel car on retrouve l'arrière plan de mon excel.

voici mon code actuel sur 8 colonnes qui peut être à besoin d’être corrigé

Private Sub Userform_Initialize() 'Mise a jour Listview
Dim I As Long
With ListView1
With .ColumnHeaders 'titre de la colonne et largeur et alignement
.Clear
.Add , , "PK", 40
.Add , , "Traverse", 40
.Add , , "Rail", 30
.Add , , "Tracé", 30
.Add , , "Devers", 40
.Add , , "Profil", 30
.Add , , "Caténaires", 45
.Add , , "Val Dég", 35
End With
With Me
.Zoom = 100 * (Application.Height / Me.Height)
.startUpPosition = 3
.Width = Application.Width
.Height = Application.Height
.Left = 0
.Top = 0
End With
.View = lvwReport
.FullRowSelect = True
.Gridlines = True

For I = 2 To Sheets.[_Default]("Sheet1").Range("A65536").End(xlUp).Row
.ListItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 1)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 2)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 3)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 4)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 5)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 6)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 7)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 8)
If Sheets.[_Default]("Sheet1").Cells(1, 20) = 0 Or Sheets.[_Default]("Sheet1").Cells(I, 8) < Sheets.[_Default]("Sheet1").Cells(1, 20) Then
.ListItems(.ListItems.Count).ListSubItems(7).ForeColor = &H80000008 ' Couleur Bleu
Else
.ListItems(.ListItems.Count).ListSubItems(7).ForeColor = &HFF& 'Couleur Rouge
End If
TextBox3.Value = ThisWorkbook.Sheets("Sheet1").Range("T1")
Next
End With
End Sub

Maintenant en fouillant sur le net j'ai trouvé un code qui apparemment réduit considérablement les exécutions de transfert, mais je n'arrive pas à l'adapter à mon code.
Code présenté tel quel , les libélés (Lib A) et quantités sont bien évidement à adapté à mon codage.

Sub Methode_B()
Dim monForm As New UserForm1
Dim i As Long
Dim mesValeurs(99, 4) As Variant
For i = 0 To 99
mesValeurs(i, 0) = i 'on inscrit par exemple un identifiant unique de ligne
mesValeurs(i, 1) = "lib_A_" & i 'on inscrit le libellé de 1ère colonne
mesValeurs(i, 2) = "lib_B_" & i 'on inscrit le libellé de 2ème colonne
mesValeurs(i, 3) = "lib_C_" & i 'on inscrit le libellé de 3ème colonne
mesValeurs(i, 4) = "lib_D_" & i 'on inscrit le libellé de 4ème colonne
Next i
monForm.ListBox1.List = mesValeurs 'on charge les valeurs en une fois dans le contrôle ListBox1
monForm.Show
End Sub

Je pense avoir été assez clair et attend avec impatience vos commentaires et encore mieux une ou des réponses.
Vous remerciant par avance

 

[JPaul13]

Bonjour Fanch55

Je te remercie vraiment, ça fonctionne super bien , même sur des tables de plus de 60 000 lignes.
je me permet de te mettre sur le podium.

PROBLÈME RÉSOLU

Merci à toutes l'équipe qui aussi fait ses propositions
A très bientôt

 

[fanch55]

Ce n'est qu'une application de toutes les recommandations .
N'oublies pas de marquer le post concerné comme solution.
Bon dimanche.