Diterlizzi31
XLDnaute Nouveau
Bonjour a tous
J'ai un soucis comme inscrit dans le titre...
J'ai beau tourné et retourné mon code dans tout les sens je trouve pas...
Alors un oeil neuf et neutre sera le bienvenue
juste pour le plaisir je vous dit l'idée...
Ces de copier de la feuille "Demandes" des donné sur la feuille "Accueil"
Le code que j'ai est une adaptation d'un code déjas existant
Sub Extraire_Arrivées()
On Error GoTo Extraire_Arrivées_Erreur
Application.ScreenUpdating = False
Worksheets("Demandes").Unprotect
Range("Demandes").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("Critères"), CopyToRange:=Range("Extraction"), Unique:=False
Application.ScreenUpdating = True
Worksheets("Demandes").Range("A4").AutoFilter
Worksheets("Demandes").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Worksheets("Accueil").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Worksheets("Accueil").EnableSelection = xlNoSelection
Extraire_Arrivées_Exit:
Exit Sub
Extraire_Arrivées_Erreur:
MsgBox Error$
Resume Extraire_Arrivées_Exit
End Sub
Merci a tout ceux qui saurons m'éclairer sur le sujet
Cordialement
J'ai un soucis comme inscrit dans le titre...
J'ai beau tourné et retourné mon code dans tout les sens je trouve pas...
Alors un oeil neuf et neutre sera le bienvenue
juste pour le plaisir je vous dit l'idée...
Ces de copier de la feuille "Demandes" des donné sur la feuille "Accueil"
Le code que j'ai est une adaptation d'un code déjas existant
Sub Extraire_Arrivées()
On Error GoTo Extraire_Arrivées_Erreur
Application.ScreenUpdating = False
Worksheets("Demandes").Unprotect
Range("Demandes").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("Critères"), CopyToRange:=Range("Extraction"), Unique:=False
Application.ScreenUpdating = True
Worksheets("Demandes").Range("A4").AutoFilter
Worksheets("Demandes").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Worksheets("Accueil").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Worksheets("Accueil").EnableSelection = xlNoSelection
Extraire_Arrivées_Exit:
Exit Sub
Extraire_Arrivées_Erreur:
MsgBox Error$
Resume Extraire_Arrivées_Exit
End Sub
Merci a tout ceux qui saurons m'éclairer sur le sujet
Cordialement