Optimisation code insertion ligne dans tableau
Bonjour,
J'ai besoin d'un peu d'aide pour mon code VBA puis-je compter sur vous ?
J'ai écrit le code suivant :
Sélection de lignes d'un tableau structuré "import" dans la feuille "import" d mon classeur
si une certaine valeur ("NE") est trouvée dans la colonne "Check" du tableau alors insérer un nouvelle ligne dans le tableau "lstcoles" de la feuille "Ecole" du même classeur avec les valeurs de plusieurs colonnes du tableau "import" et ce pour toutes les lignes du tableau "import"
Situation de base :
tableau lstecole contient 1055 lignes
Tableau import contient 244 ligne dont 241 à insérer dans lstecole.
Le code fonctionne bien mais il faut 30 minute pour l'exécuter. Alors si vous avez une idée pour optimiser…
Je vous remercie d'avance.
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
| Private Sub CommandButton1_Click()
Dim nbr As Integer
Dim row As Range
Dim tabl As ListObject
Dim i As Long
Dim ccheck As Long, cecole As Integer, cville As Integer, cadresse As Integer, ccp As Integer, ctel As Integer, ccontact As Integer, cemail As Integer
Dim vcheck As String, vecole As String, vville As String, vadresse As String, vcp As String, vtel As String, vcontact As String, vemail As String
Set tabl = ActiveSheet.ListObjects("import")
With tabl.ListColumns("check")
ccheck = .Index
End With
With tabl.ListColumns("Nom de l'établissement")
cecole = .Index
End With
With tabl.ListColumns("Adresse où les animations doivent avoir lieu: (Adresse postale)")
cadresse = .Index
End With
With tabl.ListColumns("Adresse où les animations doivent avoir lieu: (Ville)")
cville = .Index
End With
With tabl.ListColumns("Adresse où les animations doivent avoir lieu: (ZIP / Code postal)")
ccp = .Index
End With
With tabl.ListColumns("N° de Téléphone de contact:")
ctel = .Index
End With
With tabl.ListColumns("Responsable")
ccontact = .Index
End With
With tabl.ListColumns("adresse E-mail :")
cemail = .Index
End With
nbr = Range("import").Rows.Count
MsgBox nbr
i = 0
For Each row In Range("import").Rows
i = i + 1
If i < 2 Then
If Range("Import").Cells(i, ccheck) = "NEW" Then
'MsgBox i & " " & Range("Import").Cells(i, ccheck)
vecole = Range("Import").Cells(i, cecole)
vville = Range("Import").Cells(i, cville)
vadresse = Range("Import").Cells(i, cadresse)
vcp = Range("Import").Cells(i, ccp)
vtel = Range("Import").Cells(i, ctel)
vcontact = Range("Import").Cells(i, ccontact)
vemail = Range("Import").Cells(i, cemail)
'---------------------------------------------------------------------------------
'Insertion nouvelle ecole
'---------------------------------------------------------------------------------
Sheets("ecole").ListObjects("lstecoles").Range.AutoFilter Field:=2 'suppression du filtre
Sheets("ecole").ListObjects("lstecoles").ListRows(nbr + 1).Range.Insert xlShiftDown 'insertion ligne
With Sheets("ecole")
.Range("B2").Value = vecole
.Range("c2").Value = vadresse
.Range("d2").Value = vcp
.Range("e2").Value = vville
.Range("f2").Value = vtel
.Range("h2").Value = vcontact
.Range("i2").Value = vemail
End With
End If
End If
Next row
End Sub |
