Re : Marquer l'affichage pendant le travail
Bonsoir et merci pour vos pistes,
L’extraction de la feuille a traiter fait partie d'un classeurs d'une vingtaine de feuilles.
Merci pour votre aide
Si dessous le script de ma macro.
*****************
Private Sub Recup()
' Récuprération de la feuille stats
'
'Empeche l'affichage du travail
Application.ScreenUpdating = False
Dim Fichier() As String
Dim Lecture As String, Chemin As String
Dim Compte As Long
Dim NomFichier As Variant
Dim Onglet As Worksheet
Dim Nom As String, Retour As String
Dim Ligne As Long
Dim Trouve As Range
Dim version As String
' Boucle de lecture des fichiers dans un répertoire
Chemin = Range("F11")
Lecture = Dir(Chemin & "*.xls*")
Compte = 0
'Récupération de la liste des fichiers du dossier
Do
ReDim Preserve Fichier(Compte)
Fichier(UBound(Fichier)) = Lecture
Lecture = Dir
Compte = Compte + 1
Loop Until Lecture = ""
'Analyse et recopie éventuelle des onglets Protocoles
For Each NomFichier In Fichier
Workbooks.Open Filename:=Chemin & NomFichier, ReadOnly:=True
For Each Onglet In Workbooks(NomFichier).Worksheets
If Onglet.Name = "Stats_IPR" Then
Nom = Onglet.Range("A7").Value
version = Onglet.Range("A5").Value
Set Trouve = ThisWorkbook.Sheets("Reception").Range("A:A").Find(Nom, lookat:=xlWhole)
If Not Trouve Is Nothing Then
Retour = MsgBox("Nom figurant déjà dans la liste réception, voulez vous continuer", vbYesNo, "ALERTE DOUBLONS")
If Retour = vbYes Then
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(Nom).Delete
Application.DisplayAlerts = True
GoTo Reprise
End If
Else
Reprise:
Onglet.Copy After:=ThisWorkbook.Worksheets("Reception")
ThisWorkbook.Worksheets("Stats_IPR").Name = Nom
Ligne = ThisWorkbook.Sheets("Reception").Range("A" & Rows.Count).End(xlUp).Row + 1
ThisWorkbook.Sheets("Reception").Range("A" & Ligne) = Nom
ThisWorkbook.Sheets("Reception").Range("C" & Ligne) = version
'
' Place le lien correspondant pour ouvrir la feuille du meme nom
ActiveSheet.Hyperlinks.Add Anchor:=Sheets("Reception").Range("A" & Ligne), Address:="", SubAddress:=Nom & "!A1", TextToDisplay:=Nom
ThisWorkbook.Sheets("Reception").Range("B" & Ligne) = Format(Date, "dd-mm-yyyy")
Exit For
End If
End If
Next
Workbooks(NomFichier).Close False
Next
' lancer macro ClasserOnglets
' Run "ClasserOnglets"
' retour sur page reception
Sheets("Reception").Select
Range("A1").Select
End Sub