XL 2010 comment appliquer un code vba à un certain nombre de feuilles d'un classeur.

[anbar]

Bonjour

Je sollicite votre aide pour m'aider à résoudre un problème en vous remerciant d'avance

avec le code suivant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$M$3" Then

frmCalendrier.Show
End If

Application.ScreenUpdating = False
Feuil6.Activate
Range("C7:K31").ClearContents
Dim n As Integer
n = 7
For i = 1 To Worksheets.Count - 1
If Worksheets(i).Range("AC1") = Worksheets(Worksheets.Count).Range("M3") Then
For j = 2 To Worksheets(i).Range("A" & Rows.Count).End(xlUp).Row
If Left(Worksheets(i).Range("A" & j), 4) = "GB 1" Or Left(Worksheets(i).Range("A" & j), 4) = "GB 2" Or Left(Worksheets(i).Range("A" & j), 4) = "GB 3" Or Left(Worksheets(i).Range("A" & j), 4) = "GB 4" Or Left(Worksheets(i).Range("A" & j), 8) = "PIVOTS 1" Then
Worksheets(Worksheets.Count).Range(("C") & n) = Worksheets(i).Range(("A") & j)
Worksheets(Worksheets.Count).Range(("K") & n) = Worksheets(i).Range(("G") & j)
n = n + 2
End If
Next j
End If
Next i

Dim X As Integer
X = 17
For Y = 1 To Worksheets.Count - 1
If Worksheets(Y).Range("AC1") = Worksheets(Worksheets.Count).Range("M3") Then
For v = 2 To Worksheets(Y).Range("A" & Rows.Count).End(xlUp).Row
If (Worksheets(Y).Range("A" & v)) = "ALU" And (Worksheets(Y).Range("G" & v)) <> 0 Then
Worksheets(Worksheets.Count).Range(("C") & X) = "ALU GRAND VOLUME" 'Worksheets(y).Range(("A") & v)
Worksheets(Worksheets.Count).Range(("K") & X) = Worksheets(Y).Range(("G") & v)
X = X + 2
End If
Next v
End If
Next Y

Dim r As Integer
r = 19
For p = 1 To Worksheets.Count - 1
If Worksheets(p).Range("AC1") = Worksheets(Worksheets.Count).Range("M3") Then
For q = 2 To Worksheets(p).Range("A" & Rows.Count).End(xlUp).Row
If (Worksheets(p).Range("A" & q)) = "ALU 2" Then
Worksheets(Worksheets.Count).Range(("C") & r) = Worksheets(p).Range(("A") & q)
Worksheets(Worksheets.Count).Range(("K") & r) = Worksheets(p).Range(("G") & q)
r = r + 2
End If
Next q
End If
Next p

Dim a As Integer
a = 21
For b = 1 To Worksheets.Count - 1
If Worksheets(b).Range("AC1") = Worksheets(Worksheets.Count).Range("M3") Then
For c = 2 To Worksheets(b).Range("A" & Rows.Count).End(xlUp).Row
If Left(Worksheets(b).Range("A" & c), 6) = "GB ATE" Then
Worksheets(Worksheets.Count).Range(("C") & a) = Worksheets(b).Range(("A") & c)
Worksheets(Worksheets.Count).Range(("K") & a) = Worksheets(b).Range(("C") & c)
a = a + 2
End If
Next c
End If
Next b


Dim m As Integer
m = 23
For l = 1 To Worksheets.Count - 1
If Worksheets(l).Range("AC1") = Worksheets(Worksheets.Count).Range("M3") Then
For k = 2 To Worksheets(l).Range("A" & Rows.Count).End(xlUp).Row
If Left(Worksheets(l).Range("A" & k), 1) = "K" Then
Worksheets(Worksheets.Count).Range(("C") & m) = Worksheets(l).Range(("A") & k)
Worksheets(Worksheets.Count).Range(("K") & m) = Worksheets(l).Range(("C") & k)
m = m + 2
End If
Next k
End If
Next l


Dim Cel As Range, Plage As Range
Dim Mot As String
Dim Mot1 As String
Dim Mot2 As String
Dim Mot3 As String
Dim Mot4 As String
Dim Mot5 As String
Dim Mot6 As String
Dim Mot7 As String
Dim Mot8 As String
Dim Mot9 As String
Dim Mot10 As String
Set Plage = Range("C7:J31") ' à adapter à la plage à parcourir.
Mot = "GB 1" 'adapter au mot à rechercher et à supprimer
Mot1 = "GB 2"
Mot2 = "GB 3"
Mot3 = "ALU 2"
Mot4 = "GB ATE"
Mot5 = "K 1"
Mot6 = "K 2"
Mot7 = "K 3"
Mot8 = "K 4"
Mot9 = "K 5"
Mot10 = "ALU"
'Pas nécessaire si le plage est petite

For Each Cel In Plage
If Cel Like "*" & Mot & "*" Or Cel Like "*" & Mot1 & "*" Or Cel Like "*" & Mot2 & "*" Or Cel Like "*" & Mot5 & "*" Or Cel Like "*" & Mot6 & "*" Or Cel Like "*" & Mot7 & "*" Or Cel Like "*" & Mot8 & "*" Or Cel Like "*" & Mot9 & "*" Or Cel Like "*" & Mot3 & "*" Or Cel Like "*" & Mot4 & "*" Or Cel Like "Mot10" Then 'Or Cel Like "*" & Mot3 & "*" Or Cel Like "*" & Mot4 & "*"
Cel = Replace(Cel, Mot, "")
Cel = Replace(Cel, Mot1, "")
Cel = Replace(Cel, Mot2, "")
Cel = Replace(Cel, Mot3, "ALU GRAND VOLUME")
Cel = Replace(Cel, Mot4, "PETIT VOLUME ALU ET ACIER VERRE DEPOLI")
Cel = Replace(Cel, Mot5, "")
Cel = Replace(Cel, Mot6, "")
Cel = Replace(Cel, Mot7, "")
Cel = Replace(Cel, Mot8, "")
Cel = Replace(Cel, Mot9, "")
'Cel = Replace(Cel, Mot10, "ALU GRAND VOLUME ")
'Pour enlever le double espace qui en résulte..
Cel = Replace(Cel, " ", " ")
End If
Next Cel
Application.ScreenUpdating = True

End Sub

Ce code placé dans la feuille (form) pour que je puisse ramener des données des Feuilles LUNDI, MARDI, MERCREDI, JEUDI et VENDREDI à la feuille (form) en changeant la datte sur la feuille (form) le code compare cette datte saisie à la cellule M3 avec les dates saisies sur toutles les feuilles du classeur cellule AC1 et renvoie les données recherchées quand les date de (form) et celle d'une feuille sont égale.
Ce que je souhaiterai c'est de limiter l'application de ce code aux 5 feuilles qui contiennent les données qui m'interessent feuilles (LUNDI, MARDI, MERCREDI, JEUDI et VENDREDI) si non je suis obligé de marquer des dates sur toutes les feuilles.

Merci

 

[sylvanu]

Bonjour Ambar,
Tou d'abord prenez l'ahbitude d'utiliser les balises ( </> ) pour le code, c'est plus lisible.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$M$3" Then
    frmCalendrier.Show
End If

Ensuite je ne me suis pas penché sur votre code.
Mais serait il possible en AC3 des feuilles à utiliser de mettre un flag genre "Feuille concernée". et vous nommez cette cellule Flag par exemple.
Ensuite il suffirait de tester ce flag pour savoir si on doit exploiter la page :

    If [Flag] = "Feuille concernée" Then
        .... Faire le code désiré
    End If

Ou encore modifier l'appel des pages :

If Worksheets(Y).Range("AC1") = Worksheets(Worksheets.Count).Range("M3") Then

par

If Worksheets(i).Range("AC1") = Worksheets(Worksheets.Count).Range("M3") _
   And Worksheets(i).Range("AC3") = "Feuille concernée" Then

 

[anbar]

Bonjour Ambar,
Tou d'abord prenez l'ahbitude d'utiliser les balises ( </> ) pour le code, c'est plus lisible.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$M$3" Then
    frmCalendrier.Show
End If

Ensuite je ne me suis pas penché sur votre code.
Mais serait il possible en AC3 des feuilles à utiliser de mettre un flag genre "Feuille concernée". et vous nommez cette cellule Flag par exemple.
Ensuite il suffirait de tester ce flag pour savoir si on doit exploiter la page :

    If [Flag] = "Feuille concernée" Then
        .... Faire le code désiré
    End If

Ou encore modifier l'appel des pages :

If Worksheets(Y).Range("AC1") = Worksheets(Worksheets.Count).Range("M3") Then

par

If Worksheets(i).Range("AC1") = Worksheets(Worksheets.Count).Range("M3") _
   And Worksheets(i).Range("AC3") = "Feuille concernée" Then

Merci de votre aide mais ça ne résout pas le problème ou j'ai pas bien compris votre solution.

 

[sylvanu]

application de ce code aux 5 feuilles qui contiennent les données qui m'interessent feuilles (LUNDI, MARDI, MERCREDI, JEUDI et VENDREDI)

Dans les 5 feuilles LUNDI.... VENDREDI en AC1 et AC2 vous avez des données.
En AC3 vous mettez une chaîne qui dit que cette feuille doit être traitée.
Dans le code, là où vous devez utiliser les données de la feuille, vous commencez par vérifier si en AC3 vous avez la bonne valeur, dans ce cas vous traitez la feuille sinon vous passez à la feuille suivante.

If Worksheets(i).Range("AC1") = Worksheets(Worksheets.Count).Range("M3") _
   And Worksheets(i).Range("AC3") = "Feuille concernée" Then

Avec ce code vous le IF sera vrai et donc executé que si AC1=..AM3 et AC3=La chaine que vous avez choisie.

A moins que je n'ai pas compris la problématique.

J'ai mis un exemple de ce que j'ai compris avec le code suivant :

Sub test()
Dim Feuille As Worksheet
    For Each Feuille In Worksheets
        If Feuille.Range("AC3") = "OK" Then
            MsgBox (" La feuille " & Feuille.Name & " est à traiter. AC3 contient OK")
        Else
            MsgBox (" La feuille " & Feuille.Name & " n'est pas à traiter. AC3 est vide")
        End If
    Next Feuille
End Sub