Trouver une solution sur un complement de macro

  • Initiateur de la discussion Initiateur de la discussion tinet
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

tinet

XLDnaute Impliqué
Bonsoir le forum,

je cherche un coup de pouce pour régler le problème de ma macro.
mon classeur possède plusieurs feuilles.
une trentaine de feuilles numérotée de 1 à 32 avec cette fonction.

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Range("F1")) Is Nothing Then
Dim Derlig As Long, Critere As String
' Désactivation de l'affichage[/COLOR]
Application.ScreenUpdating = False
' Définition du critère du fournisseur
With Sheets("1")
Critere = .Range("F1").Text
End With
With Sheets("CATALOGUE ACHAT")
.Range("A1:M1").AutoFilter ' Mise en place du filtre automatique
.Range("A1:M1").AutoFilter Field:=12, Criteria1:=Critere ' Filtre
'Effacement des données précédentes
ActiveSheet.Unprotect Password:=Feuil07.Range("A1").Value
Sheets("1").Range("C31:H880,J31:J880,k31:k880").ClearContents
' Copie des valeurs filtrées
Derlig = .Range("B65536").End(xlUp).Row
'If Derlig < 2 Then Exit Sub
.Range("C2:f" & Derlig).Copy
ActiveSheet.Unprotect Password:=Feuil07.Range("A1").Value
Sheets("1").Range("C31").PasteSpecial Paste:=xlPasteValues
.Range("g2:g" & Derlig).Copy
Sheets("1").Range("h31").PasteSpecial Paste:=xlPasteValues
.Range("I2:I" & Derlig).Copy
Sheets("1").Range("J31").PasteSpecial Paste:=xlPasteValues
.Range("J2:J" & Derlig).Copy
Sheets("1").Range("k31").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
' Suppression du filtre automatique
.Range("A1:M1").AutoFilter
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=Feuil07.Range("A1").Value
' Affichage de la feuille résultat
With Sheets("1")
.Select
.Range("g10").Select

End With
End If

End Sub

la cellule F1 de chaque feuille dispose d'un menu déroulant et qui en fonction du choix recherche des informations sur la feuille" catalogue achat" et copie les informations sur la feuille sélectionnée.

je souhaite créer une macro qui exécuterait à un moment donné cette fonction ci-dessus à la suite de la feuille 1 à 32 en reprenant le choix de la cellule F1 pour chaque feuille.

J'ai une solution mais je dois recopier cette fonction 32 fois à la suite. 😛
 
Dernière édition:
Re : Trouver une solution sur un complement de macro

Re,

pour ignorer certaines feuilles :
Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Derlig As Long, Critere As String
If Sh.Name <> "nomfeuille1" Or Sh.Name <> "nomfeuille2" Then
If Not Application.Intersect(Target, Range("F1")) Is Nothing Then
'reste du code
End If
End If
End Sub

bon après midi
@+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
8
Affichages
493
Réponses
18
Affichages
804
Retour