Trouver une solution sur un complement de macro

[tinet]

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.

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.

 

[Pierrot93]

Re : Trouver une solution sur un complement de macro

Bonjour,

Place le code dans le module "thisworkbook" en utilisant l'événement "Workbook_SheetChange", à noter la variable "sh" représente la feuille sur laqualle la modification a été effectuée, et "target" la cellule modifiée :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

bonne journée
@+

 

[tinet]

Re : Trouver une solution sur un complement de macro

Bonjour Pierrot93,

Je vois toujours le premier à répondre.
j'ai besoin malheureusement d'un peu plus explications je ne suis pas un spécialiste en VBA.
j'arrive à modifier certaines formules et à comprendre grâce aux exemples je décortique.

mais je suis loin à pouvoir comprendre le langage.

j'ai cru comprendre que en utilisant la feuille "thisworkbook" cette fonction pourrait appeler dans n'importe quelle feuille c'est cela.....

mais maintenant comment j'écris ma formule pour récupérer ces informations.

la j'ai du mal à suivre.

 

[Pierrot93]

Re : Trouver une solution sur un complement de macro

Re,

j'ai cru comprendre que en utilisant la feuille "thisworkbook" cette fonction pourrait appeler dans n'importe quelle feuille c'est cela.....

oui c'est cela, et "sh" représente la feuille concernée...

 

[tinet]

Re : Trouver une solution sur un complement de macro

Re,

je te mets un petit fichier pour mieux comprendre, c'est plus facile pour moi

a+

 

[Pierrot93]

Re : Trouver une solution sur un complement de macro

Re,

aucune donnée dans ton classeur et nom des feuilles ne correspondent pas... En l'état je ne vois même pas le résultat attendu....

 

[tinet]

Re : Trouver une solution sur un complement de macro

Re,

J'ai juste inscrit les codes VBA.
Je voufrais juste que tu me donne l'exemple de la macro pour récupérer ces données.


Mon fichier est trop lourd pour être sur le site.
si tu as besoin du fichier je te le mettrai en pièces jointes sur le site des fichiers partagés

a+

 

[Pierrot93]

Re : Trouver une solution sur un complement de macro

Re,

il faut simplement que tu utllises "sh" au lieu de sheets("nomfeuille") pour les actions concernant la feuille modifiée....

 

[tinet]

Re : Trouver une solution sur un complement de macro

Re,

Pierrot je suis perdu.
si tu me renvoies le fichier avec l'exemple ce sera plus clair pour moi.

a+

 

[Pierrot93]

Re : Trouver une solution sur un complement de macro

Re,

comme déjà dit je ne comprends pas ton code... pourquoi tous ces noms de feuilles placés dans un module de FEUILLE.... les instructions placées dans un tel module, s'appliquent systèmatique à la feuille dans lequel le code est placé... en aucun cas il est nécessaire de nommer cette même feuille dans le code... Donc déjà tu peux enlever toutes les références "sheets(...) de cette même feuille, on y verra peut être un peu plus clair après....

 

[tinet]

Re : Trouver une solution sur un complement de macro

Re,

Si j'enléve la référence "sheets" mes formules ne marche plus.

Je t'envoie une partie du fichier.

Cijoint.fr - Service gratuit de dépôt de fichiers
a+

 

[Pierrot93]

Re : Trouver une solution sur un complement de macro

Re,

désolé, perso peux pas accéder à ce site.... dépose un tout petit fichier directement sur le forum avec seulement 2 feuilles et le minimum de données permettant de bien cerner le problème....

 

[tinet]

Re : Trouver une solution sur un complement de macro

Re,

Et voila.

a+

 

[Pierrot93]

Re : Trouver une solution sur un complement de macro

Re,

je ne comprends toujours pas ce que tu cherches à faire car aucune des feuilles dans ton fichier n'ont la même structure et la première chose que fait ton code c'est de stocker la valeur de F1 pour s'en servir comme critère...

Bon, j'ai fait comme je te l'avais dit, enlevé tous les "sheets("1").... code ci-dessous à placer dans le module "thisworkbook"... pas sûr que ce soit cela que tu attends...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Derlig As Long, Critere As String
If Not Application.Intersect(Target, Range("F1")) Is Nothing Then
' Désactivation de l'affichage
Application.ScreenUpdating = False
' Définition du critère du fournisseur
Critere = Range("F1").Text
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
Range("C17:H865,J17:J865,L17:L865").ClearContents
' Copie des valeurs filtrées
Derlig = .Range("B65536").End(xlUp).Row
If Derlig < 2 Then Exit Sub
.Range("C2:F" & Derlig).Copy
Range("C17").PasteSpecial Paste:=xlPasteValues
.Range("G2:G" & Derlig).Copy
Range("H17").PasteSpecial Paste:=xlPasteValues
.Range("I2:I" & Derlig).Copy
Range("J17").PasteSpecial Paste:=xlPasteValues
.Range("J2:J" & Derlig).Copy
Range("L17").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
' Suppression du filtre automatique
.Range("A1:M1").AutoFilter
End With
' Affichage de la feuille résultat
End If
End Sub

 

[tinet]

Re : Trouver une solution sur un complement de macro

Re,

ok la fonction positionner dans thisworkbook remplace ma fonction que j'avais positionné sur chaque feuille.
Mais malheureusement j'ai d'autres feuilles qui vont subir cette fonction. la pas cool.
à moins qu'il y a moyen de sélectionner certaines feuilles
mais je garde l'idée que je ne connaissais pas.

a+