Scintillement écran exécution macro import données par copy

Question

En vous remerciant de l'aide que vous pourrez m'apporter. Je souhaiterais vous soumettre une macro pour avis et/ou correction. En effet j'ai un soucis de scintillement d'écran à l’exécution de la macro Spécification fonctionnelle : La macro à pour objectif de réaliser un import de données (par copy) de certaines plages de l'ensemble des feuilles visibles d'un classeur excel puis d'enregistrer celui-ci dans le FolderPath ou plus précisément dans le dossier où le classeur parent est enregistré Scénario : 1 - Clic sur bouton "Import" depuis onglet Dashboard 2 - Affiche la boite de dialogue Windows 3 - Sélection par l'utilisateur du fichier à importer 4 - Clic sur bouton ouvrir de la boite de dialogue ----&gt; Macro se lance 5 - La macro initialise les variables d'une progressbar 6 - La macro appelle le module associée à la progressbar 7 - La boucle d'import débute "For each onglet in ActiveWorkbook.Worksheets" 8 - La macro incrémente le compteur de la progressbar 9 - A la fin de l'action un modal s'ouvre pour indiquer à l'utilisateur que le fichier a été sauvegardé sous le nom : &#91;...&#93; Mes observations : 1 - Agissant par copy et malgré que j'eus désactivé le rafraîchissement et les événements, le classeur "clignote" et donc la progressbar avec. 2 - L'idéal eut été qu'un dossier soit créé avec la date du jour et que soient enregistrés les imports du jour dans ce répertoire. 3 - Si l'utilisateur vient à créer un nouvel onglet ne pas le récupérer. 4 - Avant enregistrement demander à l'utilisateur le nom de l'entité et la rajouter à la fin du nom de classeur. Ci-joint visuel explicatif + macro Option Explicit Dim m_ING_derniereLigne As Long 'X Dim m_ING_premiereLigne As Long 'X Dim m_STR_nomTab As Worksheet 'X Dim m_WST_feuilleRef As Worksheet 'X Dim m_STR_cheminFichier As String 'X Dim m_STR_nomFichier As String 'X Dim m_STR_nomTab As String 'X Dim m_STR_nomFichierSaveAs As String 'X Dim m_STR_cheminFichierSave As String 'X Sub Import(control As IRibbonControl) On Error GoTo Erreurs 'start = Timer Dim Status As StatusType '---------------------------------------------------------------------------------------------------------- 'Partie 1' Set m_WST_feuilleRef = ActiveSheet Application.StatusBar = "Loading…" Application.ScreenUpdating = False Application.EnableEvents = False 'Sélection du classeur source à partir d'une fenêtre m_WST_feuilleRef = Application.GetOpenFilename("Fichiers Excels (*.xlsm), *.xlsm") Workbooks.Open m_WST_feuilleRef m_STR_nomFichier = Dir(m_WST_feuilleRef) 'Déclaration de variables locales Dim lngCounter As Long Dim lngNumberOfTasks As Long 'Initialisation de variables tâches progressbar lngNumberOfTasks = 9 'appel de la progressbar initialisée à 0, pour donner une indication à l'utilisateur de l'avancement du traitement Call modProgress.ShowProgress(0, lngNumberOfTasks, _ "Excel is working on Task Number 1", False, _ "Being processed") For lngCounter = 1 To lngNumberOfTasks '---------------------------------------------------------------------------------------------------------- 'Partie 2' 'Boucle For Each m_STR_nomTab In ActiveWorkbook.Worksheets 'Disable Screen Updating and Events m_STR_nomTab = m_STR_nomTab.Name With m_STR_nomTab If m_STR_nomTab.Visible = True And m_STR_nomTab &lt;&gt; "Dashboard" And m_STR_nomTab &lt;&gt; "8-Additional Questions" Then m_STR_nomTab.Activate m_ING_derniereLigne = Worksheets(m_STR_nomTab).Cells(Rows.Count, "E").End(xlUp).Row m_ING_premiereLigne = m_ING_derniereLigne + 1 Workbooks(m_STR_nomFichier).Sheets(m_STR_nomTab).Activate Workbooks("Cardiff_Admin_Import.xlsm").Sheets(m_STR_nomTab).Activate Workbooks("Cardiff_Admin_Import.xlsm").Worksheets(m_STR_nomTab).Range("E11:R" &amp; m_ING_derniereLigne).ClearContents Workbooks(m_STR_nomFichier).Sheets(m_STR_nomTab).Range("E11:R" &amp; m_ING_derniereLigne).Copy Workbooks("Cardiff_Admin_Import.xlsm").Worksheets(m_STR_nomTab).Range("E11").PasteSpecial (xlPasteValues) End If End With 'Appel de la progressbar à chaque tâche achevée X+1 Call modProgress.ShowProgress(lngCounter, lngNumberOfTasks, _ "Excel is working on Task Number " &amp; lngCounter + 1, False) Next m_STR_nomTab Next lngCounter '---------------------------------------------------------------------------------------------------------- 'Partie 3' 'Enregistrement du classeur m_WST_feuilleRef.Activate ActiveWorkbook.RefreshAll 'MsgBox "durée du traitement: " &amp; Timer - start &amp; " secondes" m_STR_nomFichierSaveAs = Format(Now, "hhmmss") &amp; "-" &amp; Day(Date) &amp; "-" &amp; Month(Date) &amp; "-" &amp; Year(Date) &amp; "_" &amp; ActiveWorkbook.Name ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path &amp; "\" &amp; m_STR_nomFichierSaveAs m_STR_cheminFichierSave = MsgBox("Votre fichier est sauvegardé sous le nom : " &amp; m_STR_nomFichierSaveAs, vbYes + vbInformation, "Copie sauvegarde classeur") Workbooks(m_STR_nomFichier).Close False '---------------------------------------------------------------------------------------------------------- 'Gestion des erreurs' 'Etiquettes en cas d'erreurs Sortie: Exit Sub Erreurs: If Err.Number = 1004 Then MsgBox "Extract data task aborted by user", vbOKOnly + vbInformation, "Cardiff Tool" Resume Sortie End If 'Active ScreenUpdating and Events Application.StatusBar = "Complete, Enjoy !" Application.ScreenUpdating = True Application.EnableEvents = True End Sub Merci beaucoup de toute l'aide que vous pourrez m'apporter...

LouReeD · Answer

Avez vous essayer de faire un : Application.visible = false puis = True en fin de code ? @ bientôt LouReeD...

LouReeD · Answer

Et merci pour ce retour ! Même après presque 4 mois ! Tant de réponses laissées sans réponses ! Merci @ vous ! Bon je suis content que vous ayez trouvé la solution, mais pour les autres forumeurs, une copie de votre nouveau code serait le bienvenu afin de faire une comparaison entre l'ancien et ce dernier @ bientôt LouReed...