Complété ma macro

[wachoo31]

Bonjour à toutes et tous et tout mes bon voeux evec un peu d'avance,

J'ai recu, il y a quelques temps, d' un membre du forum cette macro qui me sert énormément, mais aujourd'hui en modifiant mon fichier, notament ajout d'une feuille nomée Menu, j'ai une erreur 13 a chaque fois que la macro se lance.


Ma demande est que doit je ajouter et ou pour que dans la boucle de recherche des feuille, la feuille menu ne soit pas prise en code

Ci dessous la macro car fichier trop volumineux


------------------------------------------------------------------------
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Err_Worksheet_Change
'Déclaration de variable
Dim Feuil_Réf As String
Dim X As Integer
Dim Lg_Réf As Long
Dim Col_Date As Integer
Dim Col_Art As Integer
Dim Lg_Cours As Long
Dim Ind_Feuil As Integer

'blocage des événements pour empêcher que la suppression les déclenche
Application.EnableEvents = False

'si c'est pas la bonne cellule ou A1 est vide, on sort
If Target.Address <> "$A$1" Or IsEmpty(Target) Then GoTo Sort_Worksheet_Change


'Comme c'est la bonne cellule, on verifie que c'est bien une date
If Not (IsDate(Target)) Then
'si on est là, c'est que c'est pas une date valide
'on avertit
MsgBox ("A1 doit contenir une date")
'on sort
Target.Select
GoTo Sort_Worksheet_Change
End If

'Donc, A1 contient une date, on peut traiter le problème

'Mise à l'Etat Initial
'recherche de la dernière ligne non-vide
Lg_Réf = Range("A65536").End(xlUp).Row

'sélection des lignes et effacement des lignes de l'ancienne date
If Lg_Réf > 2 Then
'suppression des lignes
Range("3:" & Lg_Réf).Rows.Delete
End If

'Stockage du nom de la feuille
Feuil_Réf = ActiveSheet.Name
Lg_Réf = 3

For Ind_Feuil = 1 To Sheets.Count 'on va de l'indice 1 au nombre de feuilles
'on ne traite pas le feuille Récap
If Sheets(Ind_Feuil).Name = Feuil_Réf Then GoTo Sortie_Boucle_Feuille
'MEI
Col_Art = 0
Col_Date = 0

'Recheche de la colonne article
For X = 1 To Sheets(Ind_Feuil).Range("IV3").End(xlToLeft).Column
If Sheets(Feuil_Réf).Range("A2") = Sheets(Ind_Feuil).Cells(3, X) Then
Col_Art = X
Exit For
End If
Next X
'si pas de colonne correspondant à l'intitulé colonne article, on zappe la feuille
If Col_Art = 0 Then GoTo Sortie_Boucle_Feuille

'Recheche de la colonne date
For X = 1 To Sheets(Ind_Feuil).Range("IV3").End(xlToLeft).Column
If Sheets(Feuil_Réf).Range("B2") = Sheets(Ind_Feuil).Cells(3, X) Then
Col_Date = X
Exit For
End If
Next X
'si pas de colonne correspondant à l'intitulé colonne date, on zappe la feuille
If Col_Date = 0 Then GoTo Sortie_Boucle_Feuille

For Lg_Cours = 4 To Sheets(Ind_Feuil).Cells(65535, Col_Date).End(xlUp).Row
'on teste si la date de l'article est supérieure à la date référence
If Sheets(Ind_Feuil).Cells(Lg_Cours, Col_Date) > Sheets(Feuil_Réf).Range("A1") Then
With Sheets(Feuil_Réf)
'copie article
.Cells(Lg_Réf, 1) = Sheets(Ind_Feuil).Cells(Lg_Cours, Col_Art)
'copie date
.Cells(Lg_Réf, 2) = Sheets(Ind_Feuil).Cells(Lg_Cours, Col_Date)
'copie nom feuille
.Cells(Lg_Réf, 3) = Sheets(Ind_Feuil).Name
'copie ligne
.Cells(Lg_Réf, 4) = Lg_Cours
End With
'on passe à la ligne suivante
Lg_Réf = Lg_Réf + 1
End If
Next Lg_Cours
Sortie_Boucle_Feuille:
Next Ind_Feuil

Sort_Worksheet_Change:
'Remise en route des événements
Application.EnableEvents = True
Exit Sub
Err_Worksheet_Change:
MsgBox (Err.Number & " - " & Err.Description)
Resume Sort_Worksheet_Change
End Sub
-------------------------------------------------------------------------
Merci a toi d'avoir lu jusqu'au bout et encore une fois mes bon voeux

 

[pierrejean]

Re : Complété ma macro

bonjour

a tester
la modif suivante
'on ne traite pas le feuille Récap ni la feuille Menu
If Sheets(Ind_Feuil).Name = Feuil_Réf Or Sheets(Ind_Feuil).Name = "Menu" Then GoTo Sortie_Boucle_Feuille

 

[wachoo31]

Re : Complété ma macro

Bonjour PierreJean, Re le forum

Un grand merci à toi cela marche nickel

Passe de bon réveillons