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 : Sélectionner tout - Visualiser dans une fenêtre à part
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