Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Recopie d'une feuille d'un classeur fermé protégé en lecture

Recopie d'une feuille d'un classeur fermé protégé en lecture

1 réponse
Avatar
Le Nordiste
Bonjour tertous,

Apr=E9s n+1 recherche sur le group et pas moins de travail, je vous fait
part de la macro suivante :

Elle permet de recopier dans le classeur actif un feuille d'un classeur
ferm=E9 m=EAme si celui-ci est prot=E9g=E9 en lecture

Sub CopieFeuilleInt=E9grale()
'RECOPIE LA FEUILLE D=C9SIGN=C9E D'UN FICHIER SOURCE SANS L'OUVRIR
'DANS UNE FEUILLE DU M=CBME NOM CR=C9=C9E DANS LE CLASSEUR ACTIF

'D=C9CLARATIONS DES VARIABLES
Dim strChemin As String
Dim strFichierSource As String
Dim strFeuilleSource As String
Dim UneFeuille As Worksheet

'-----------------------------------------------------------------
On Error GoTo ErrorManager
'-----------------------------------------------------------------
'POUR ACCELERER LA PROC=C9DURE
Application.ScreenUpdating =3D False
Application.EnableEvents =3D False
Application.Calculation =3D xlCalculationManual



'POUR ACCEDER JUSQU'=C0 LA FEUILLE DU FICHIER SOURCE
strChemin =3D "D:\nom_de_repertoire"
strFichierSource =3D "nom_de_fichier.xls"
strFeuilleSource =3D "nom_de_feuille"


'-----------------------------------------------------------------
'RECHERCHE DE LA FEUILLE COPI=C9E ET EFFACEMENT DE CELLE CI
' Une nouvelle copie est faite =E0 chaque appel de la proc=E9dure
For Each UneFeuille In ActiveWorkbook.Sheets
If UneFeuille.Name =3D strFeuilleSource Then
Application.DisplayAlerts =3D False
Sheets(strFeuilleSource).Select
ActiveWindow.SelectedSheets.Delete
End If
Next UneFeuille
'-----------------------------------------------------------------
'RECOPIE DE LA FEUILLE SOURCE DANS LA FEUILLE CIBLE
Set UneFeuille =3D GetObject(strChemin & "\" &
strFichierSource).Sheets(strFeuilleSource)
GetObject(strChemin & "\" &
strFichierSource).Sheets(strFeuilleSource).Copy After:=3D _

ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)


'RESTAURATION DE L'ACCEL=C9RATEUR
Application.EnableEvents =3D True
Application.Calculation =3D xlCalculationAutomatic


Exit Sub
'--------------------------------------------------------------------------=
--------------------
ErrorManager:
MsgBox "Une erreur est survenue induisant un arr=E9t de la copie de " &
strFeuilleSource
'-----------------------------------------------------------------

End Sub

Une feuille nouvelle est cr=E9=E9e =E0 chaque recopie apr=E9s suppression
de la feuille de copie pr=E9c=E9dente.
ceci implique que l'on ne peut y porter des annotations. Pour =E9viter
cela je masque la feuille


En souhaitant que cela puisse servir =E0 d'autre.
Si des am=E9liorations sont apport=E9es je vous serais reconnaissant de
me les faire connaitre.
Signaler un problème avec ce contenu

1 réponse

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
RGO
Votre msg illustre bien ce qui anime ce forum.
C'est cet esprit de partage que j'apprécie tout particulièrement ici.
merci
rgo

"Le Nordiste" a écrit dans le message de
news:
Bonjour tertous,

Aprés n+1 recherche sur le group et pas moins de travail, je vous fait
part de la macro suivante :

Elle permet de recopier dans le classeur actif un feuille d'un classeur
fermé même si celui-ci est protégé en lecture

Sub CopieFeuilleIntégrale()
'RECOPIE LA FEUILLE DÉSIGNÉE D'UN FICHIER SOURCE SANS L'OUVRIR
'DANS UNE FEUILLE DU MËME NOM CRÉÉE DANS LE CLASSEUR ACTIF

'DÉCLARATIONS DES VARIABLES
Dim strChemin As String
Dim strFichierSource As String
Dim strFeuilleSource As String
Dim UneFeuille As Worksheet

'-----------------------------------------------------------------
On Error GoTo ErrorManager
'-----------------------------------------------------------------
'POUR ACCELERER LA PROCÉDURE
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual



'POUR ACCEDER JUSQU'À LA FEUILLE DU FICHIER SOURCE
strChemin = "D:nom_de_repertoire"
strFichierSource = "nom_de_fichier.xls"
strFeuilleSource = "nom_de_feuille"


'-----------------------------------------------------------------
'RECHERCHE DE LA FEUILLE COPIÉE ET EFFACEMENT DE CELLE CI
' Une nouvelle copie est faite à chaque appel de la procédure
For Each UneFeuille In ActiveWorkbook.Sheets
If UneFeuille.Name = strFeuilleSource Then
Application.DisplayAlerts = False
Sheets(strFeuilleSource).Select
ActiveWindow.SelectedSheets.Delete
End If
Next UneFeuille
'-----------------------------------------------------------------
'RECOPIE DE LA FEUILLE SOURCE DANS LA FEUILLE CIBLE
Set UneFeuille = GetObject(strChemin & "" &
strFichierSource).Sheets(strFeuilleSource)
GetObject(strChemin & "" &
strFichierSource).Sheets(strFeuilleSource).Copy After:= _

ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)


'RESTAURATION DE L'ACCELÉRATEUR
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic


Exit Sub
'---------------------------------------------------------------------------
-------------------
ErrorManager:
MsgBox "Une erreur est survenue induisant un arrét de la copie de " &
strFeuilleSource
'-----------------------------------------------------------------

End Sub

Une feuille nouvelle est créée à chaque recopie aprés suppression
de la feuille de copie précédente.
ceci implique que l'on ne peut y porter des annotations. Pour éviter
cela je masque la feuille


En souhaitant que cela puisse servir à d'autre.
Si des améliorations sont apportées je vous serais reconnaissant de
me les faire connaitre.