VBA plante - Macro très longue à s'éxécuter

Bonjour,

J'ai besoin SVP d'une petite aide sur une "macro" qui fonctionne bien, mais qui plante. Elle est très longue à exécuter, on ne voit pas si elle continue de travailler ou pas. J'ai essayé plusieurs choses, mais sans succès.

La "macro" consiste à un copier-coller. Des informations sont prises sur la base de données pour ensuite être recopiées sur les onglets "Agents TITULAIRES CAP" et "Agents NON TITULAIRES CAP" et en cliquant sur le bouton MAJ présent dans chacun de ces deux fichiers (en haut à droite dans le fichier joint", la "macro" s'exécute. On n'en voit pas le bout.

Cette "macro" a été réalisée sur une autre base de données et elle fonctionne très bien. Est-ce un problème dû aux informations renseignées sur la base de données ?

Je vous remercie par avance pour l'

aide que vous pourrez m'apporter.

Cordialement

Alexandra

J'ai réglé le problème. J'ai revu la base de données et ça fonctionne à nouveau et rapidement.

Cordialement

Prya

Bonjour,

Ben c'est pas de la macro de compétition hein... mais la macro de copie fonctionne pas trop mal...

Par contre ce sont les macros de suppression qui sont un peu lente, mais c'est normal car il y a de nombreuses lignes à supprimer.

Et encore tu n'as rien vu car au lieu de supprimer colonne O il fallait regarder dans la colonne N pour les trimestres ! Donc c'est encore plus long car tu as maintenant 2 boucles très longues à exécuter...

Bon je t'ai quand même amélioré ça un peu, mais ça prend encore environ 8 minutes...

Pour améliorer ça significativement, il faudrait procéder différemment (importer des données filtrées depuis la BD) probablement que ça serait instantané, mais je n'ai pas essayé. (car je ne suis pas un virtuose des filtres élaborés) D'autres te feont surement quelque ça.

Ma contribution :

Sub Recopie_NT()
Dim Source As String
Dim Cible As String
Dim LigneEncours As Long
Dim Arr, iLastRow&
'Chargement du nom des feuilles origine et destination
Cible = "Agents NON TITULAIRES CAP"
Source = "Base de donnée OK"

'Copie des valeurs
With Worksheets(Cible)
Worksheets(Source).Range("C8:C1000").Copy .Range("A23") 'Nom
Worksheets(Source).Range("D8:D1000").Copy .Range("B23") 'prénom
Worksheets(Source).Range("AN8:AN1000").Copy .Range("C23") 'Statut
Worksheets(Source).Range("B8:B1000").Copy .Range("D23") ' département de formation
Worksheets(Source).Range("AP8:AP1000").Copy .Range("E23") 'diplôme
Worksheets(Source).Range("AO8:AO1000").Copy .Range("F23") 'période d'intervention
Worksheets(Source).Range("Q8:Q1000").Copy .Range("J23") 'nbre HETd prévisionnel
Worksheets(Source).Range("S8:S1000").Copy .Range("N23") 'semestre
Worksheets(Source).Range("K8:K1000").Copy .Range("O23") 'adresse mail vacataire

Application.ScreenUpdating = False
Application.Calculation = xlManual
iLastRow = .Range("C" & .Rows.Count).End(xlUp).Row
'On travaille sur un tableau virtuel...
Arr = Range("N1:N" & iLastRow).Value
'Suppression semestre 2
            For i = UBound(Arr) To 23 Step -1
                        If Arr(i, 1) = 2 Then .Rows(i).Delete
            Next i
'il y a moins de lignes donc on recalcule la dernière ligne
iLastRow = .Range("C" & .Rows.Count).End(xlUp).Row
'On travaille sur un tableau virtuel...
Arr = Range("C1:C" & iLastRow).Value
'et on supprie les lignes correspondantes...
            For i = UBound(Arr) To 23 Step -1
                    If Arr(i, 1) = "T" Then .Rows(i).Delete
            Next i
End With
Application.Calculation = xlAutomatic
End Sub

A+

Merci Galopin 01.

J'ai essayé sur cette même base de données et ça a planté. En revanche sur une base de données propre ça fonctionne et vite.

Merci pour votre aide.

Prya