Certains d'entre vous (Youky, FxM, Jacky, LSteph, JB, ...) m'ont développé
des macros qui misent bout à bout donnent le résultat suivant (voir plus
bas). Jusqu'à la semaine dernière tout se passait normalement et aujourd'hui
il y a des "fonctions" qui ne sont plus actives.
Par exemple, en BA16 si on répond OUI à la question "est-ce un NEW ?", ça
marche, mais la question ne se pose plus en BC16 !
Par contre en AF 37 à la même question ça marche et en AF39 ça marche encore !
Quelqu'un peut-il me renseigner sur l'éventuelle manip à faire, c'est trop
fort pour moi.
D'avance merci pour votre patience et votre aide.
Ci-dessous la macro :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iSect As Range, jSect As Range, kSect As Range, lSect As Range, mSect As
Range, c As Range
Set iSect = Intersect(Target, Range("ab37:ab56"))
Set jSect = Intersect(Target, Range("ba6:cc6"))
Set kSect = Intersect(Target, Range("ba16:cc16"))
Set lSect = Intersect(Target, Range("af37:af56"))
Set mSect = Intersect(Target, Range("i58:ai58"))
If Not iSect Is Nothing Then
For Each c In iSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not jSect Is Nothing Then
For Each c In jSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not kSect Is Nothing Then
For Each c In kSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not lSect Is Nothing Then
For Each c In lSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not mSect Is Nothing Then
For Each c In mSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
'macro plage 1
If Not Intersect(Target, Range("ba6:cc6")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", 4, Application.UserName)
If question = 7 Then
rep = MsgBox("Le texte est-il DITO ?", 4, Application.UserName)
If rep = 7 Then
[AW8].Select
Selection.ClearContents
Exit Sub
End If
Else
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4,
Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW"
[AW8].Select
Selection.ClearContents
Else
For k = 53 To 81 Step 2
If Feuil2.Cells(6, k) = "" Then Feuil2.Cells(6, k) = Target.Value: Exit
For
Next
Target.Value = ""
End If
End If
Application.EnableEvents = True
End If
'macro plage 2
If Not Intersect(Target, Range("ba16:cc16")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4,
Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub
Else
For k = 53 To 81 Step 2
If Feuil2.Cells(16, k) = "" Then Feuil2.Cells(16, k) =
Target.Value: Exit For
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If
'macro plage 3
If Not Intersect(Target,
Range("AF37,AF39,AF41,AF43,AF45,AF47,AF49,AF51,AF53,AF55")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
question = MsgBox("La facturation se fait-elle sur 12 mois ?",
4, Application.UserName)
If question = 7 Then
Cells(Target.Row + 1, Target.Column) = "NEW": Exit Sub
Else
Application.EnableEvents = False
For lig = 37 To 56 Step 2
If Feuil2.Cells(lig, 2) = "" Then Exit For
Next
If lig > 56 Then MsgBox "complet": Application.EnableEvents
= True: Exit Sub
mycol = Array(0, 2, 5, 20, 32, 35, 37, 39)
For k = 1 To 7
Feuil2.Cells(lig, mycol(k)) = Feuil1.Cells(Target.Row,
mycol(k))
If Feuil1.Range("AB" & Target.Row) = "" Then
Feuil1.Cells(Target.Row, mycol(k)) = ""
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If
'macro plage 4
If Not Intersect(Target, Range("I58:AI58")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?",
4, Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub
Else
For k = 9 To 35 Step 2
If Feuil2.Cells(58, k) = "" Then Feuil2.Cells(58, k) =
Target.Value: Exit For
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If
'macro plage 5
If Not Intersect(Target,
Range("AB37,AB39,AB41,AB43,AB45,AB47,AB49,AB51,AB53,AB55")) Is Nothing Then
If Left(Cells(Target.Row, Target.Column), 2) = "IL" Or
Left(Cells(Target.Row, Target.Column), 1) = "B" Or Left(Cells(Target.Row,
Target.Column), 2) = "1B" Or Left(Cells(Target.Row, Target.Column), 2) = "2B"
Or Left(Cells(Target.Row, Target.Column), 1) = "L" Or Left(Cells(Target.Row,
Target.Column), 1) = "J" Or Left(Cells(Target.Row, Target.Column), 2) = "1J"
Or Left(Cells(Target.Row, Target.Column), 1) = "2J" Then
question = MsgBox("Est-ce un dito ?", vbYesNo, Application.UserName)
If question = vbYes Then
Cells(Target.Row + 1, Target.Column) = "DITO 2006": Exit Sub
End If
End If
End If
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Youky
Salut, Ta macro tourne chez moi comme tu le souhaite. La fusion de tes cellules à cet endroit à peut être été modifées Je vois que cette seule solution en fenetre Execution au cas ou... lance cette ligne et <Enter> Application.EnableEvents = True
ici j'ai raccourci le début de la macro, le restant étant inchangé Youky
Dim iSect As Range, c As Range Set iSect = Intersect(Target, Range("ab37:ab56,ba6:cc6,ba16:cc16,af37:af56,i58:ai58")) If Not iSect Is Nothing Then For Each c In iSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(1, 0).ClearContents Application.EnableEvents = True Next End If
If Target.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub
'macro plage 1 et le restant de la macro inchangée
"Nicoh" a écrit dans le message de news:
Bonjour à tous,
Certains d'entre vous (Youky, FxM, Jacky, LSteph, JB, ...) m'ont développé des macros qui misent bout à bout donnent le résultat suivant (voir plus bas). Jusqu'à la semaine dernière tout se passait normalement et aujourd'hui il y a des "fonctions" qui ne sont plus actives. Par exemple, en BA16 si on répond OUI à la question "est-ce un NEW ?", ça marche, mais la question ne se pose plus en BC16 ! Par contre en AF 37 à la même question ça marche et en AF39 ça marche encore ! Quelqu'un peut-il me renseigner sur l'éventuelle manip à faire, c'est trop fort pour moi.
D'avance merci pour votre patience et votre aide.
Ci-dessous la macro : Private Sub Worksheet_Change(ByVal Target As Range)
Dim iSect As Range, jSect As Range, kSect As Range, lSect As Range, mSect As Range, c As Range Set iSect = Intersect(Target, Range("ab37:ab56")) Set jSect = Intersect(Target, Range("ba6:cc6")) Set kSect = Intersect(Target, Range("ba16:cc16")) Set lSect = Intersect(Target, Range("af37:af56")) Set mSect = Intersect(Target, Range("i58:ai58")) If Not iSect Is Nothing Then For Each c In iSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(1, 0).ClearContents Application.EnableEvents = True Next End If If Not jSect Is Nothing Then For Each c In jSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(-1, 0).ClearContents Application.EnableEvents = True Next End If If Not kSect Is Nothing Then For Each c In kSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(-1, 0).ClearContents Application.EnableEvents = True Next End If If Not lSect Is Nothing Then For Each c In lSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(1, 0).ClearContents Application.EnableEvents = True Next End If If Not mSect Is Nothing Then For Each c In mSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(-1, 0).ClearContents Application.EnableEvents = True Next End If
If Target.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub
'macro plage 1
If Not Intersect(Target, Range("ba6:cc6")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", 4, Application.UserName) If question = 7 Then rep = MsgBox("Le texte est-il DITO ?", 4, Application.UserName) If rep = 7 Then [AW8].Select Selection.ClearContents Exit Sub End If Else Application.EnableEvents = False question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row - 1, Target.Column) = "NEW" [AW8].Select Selection.ClearContents Else For k = 53 To 81 Step 2 If Feuil2.Cells(6, k) = "" Then Feuil2.Cells(6, k) = Target.Value: Exit For Next Target.Value = "" End If End If Application.EnableEvents = True End If
'macro plage 2
If Not Intersect(Target, Range("ba16:cc16")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName) If question = vbYes Then Application.EnableEvents = False question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub Else For k = 53 To 81 Step 2 If Feuil2.Cells(16, k) = "" Then Feuil2.Cells(16, k) > Target.Value: Exit For Next Target.Value = "" End If Application.EnableEvents = True End If End If
'macro plage 3
If Not Intersect(Target, Range("AF37,AF39,AF41,AF43,AF45,AF47,AF49,AF51,AF53,AF55")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName) If question = vbYes Then question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row + 1, Target.Column) = "NEW": Exit Sub Else Application.EnableEvents = False For lig = 37 To 56 Step 2 If Feuil2.Cells(lig, 2) = "" Then Exit For Next If lig > 56 Then MsgBox "complet": Application.EnableEvents = True: Exit Sub mycol = Array(0, 2, 5, 20, 32, 35, 37, 39) For k = 1 To 7 Feuil2.Cells(lig, mycol(k)) = Feuil1.Cells(Target.Row, mycol(k)) If Feuil1.Range("AB" & Target.Row) = "" Then Feuil1.Cells(Target.Row, mycol(k)) = "" Next Target.Value = "" End If Application.EnableEvents = True End If End If
'macro plage 4
If Not Intersect(Target, Range("I58:AI58")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName) If question = vbYes Then Application.EnableEvents = False question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub Else For k = 9 To 35 Step 2 If Feuil2.Cells(58, k) = "" Then Feuil2.Cells(58, k) > Target.Value: Exit For Next Target.Value = "" End If Application.EnableEvents = True End If End If
'macro plage 5
If Not Intersect(Target, Range("AB37,AB39,AB41,AB43,AB45,AB47,AB49,AB51,AB53,AB55")) Is Nothing Then If Left(Cells(Target.Row, Target.Column), 2) = "IL" Or Left(Cells(Target.Row, Target.Column), 1) = "B" Or Left(Cells(Target.Row, Target.Column), 2) = "1B" Or Left(Cells(Target.Row, Target.Column), 2) = "2B" Or Left(Cells(Target.Row, Target.Column), 1) = "L" Or Left(Cells(Target.Row, Target.Column), 1) = "J" Or Left(Cells(Target.Row, Target.Column), 2) = "1J" Or Left(Cells(Target.Row, Target.Column), 1) = "2J" Then question = MsgBox("Est-ce un dito ?", vbYesNo, Application.UserName) If question = vbYes Then Cells(Target.Row + 1, Target.Column) = "DITO 2006": Exit Sub End If End If End If
End Sub
Salut,
Ta macro tourne chez moi comme tu le souhaite.
La fusion de tes cellules à cet endroit à peut être été modifées
Je vois que cette seule solution
en fenetre Execution au cas ou... lance cette ligne et <Enter>
Application.EnableEvents = True
ici j'ai raccourci le début de la macro, le restant étant inchangé
Youky
Dim iSect As Range, c As Range
Set iSect = Intersect(Target,
Range("ab37:ab56,ba6:cc6,ba16:cc16,af37:af56,i58:ai58"))
If Not iSect Is Nothing Then
For Each c In iSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
'macro plage 1
et le restant de la macro inchangée
"Nicoh" <Nicoh@discussions.microsoft.com> a écrit dans le message de news:
57D330B2-F849-4E99-A67D-C4140A2F19BA@microsoft.com...
Bonjour à tous,
Certains d'entre vous (Youky, FxM, Jacky, LSteph, JB, ...) m'ont développé
des macros qui misent bout à bout donnent le résultat suivant (voir plus
bas). Jusqu'à la semaine dernière tout se passait normalement et
aujourd'hui
il y a des "fonctions" qui ne sont plus actives.
Par exemple, en BA16 si on répond OUI à la question "est-ce un NEW ?", ça
marche, mais la question ne se pose plus en BC16 !
Par contre en AF 37 à la même question ça marche et en AF39 ça marche
encore !
Quelqu'un peut-il me renseigner sur l'éventuelle manip à faire, c'est trop
fort pour moi.
D'avance merci pour votre patience et votre aide.
Ci-dessous la macro :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iSect As Range, jSect As Range, kSect As Range, lSect As Range, mSect
As
Range, c As Range
Set iSect = Intersect(Target, Range("ab37:ab56"))
Set jSect = Intersect(Target, Range("ba6:cc6"))
Set kSect = Intersect(Target, Range("ba16:cc16"))
Set lSect = Intersect(Target, Range("af37:af56"))
Set mSect = Intersect(Target, Range("i58:ai58"))
If Not iSect Is Nothing Then
For Each c In iSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not jSect Is Nothing Then
For Each c In jSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not kSect Is Nothing Then
For Each c In kSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not lSect Is Nothing Then
For Each c In lSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not mSect Is Nothing Then
For Each c In mSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
'macro plage 1
If Not Intersect(Target, Range("ba6:cc6")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", 4, Application.UserName)
If question = 7 Then
rep = MsgBox("Le texte est-il DITO ?", 4, Application.UserName)
If rep = 7 Then
[AW8].Select
Selection.ClearContents
Exit Sub
End If
Else
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4,
Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW"
[AW8].Select
Selection.ClearContents
Else
For k = 53 To 81 Step 2
If Feuil2.Cells(6, k) = "" Then Feuil2.Cells(6, k) = Target.Value:
Exit
For
Next
Target.Value = ""
End If
End If
Application.EnableEvents = True
End If
'macro plage 2
If Not Intersect(Target, Range("ba16:cc16")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4,
Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub
Else
For k = 53 To 81 Step 2
If Feuil2.Cells(16, k) = "" Then Feuil2.Cells(16, k) > Target.Value: Exit For
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If
'macro plage 3
If Not Intersect(Target,
Range("AF37,AF39,AF41,AF43,AF45,AF47,AF49,AF51,AF53,AF55")) Is Nothing
Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
question = MsgBox("La facturation se fait-elle sur 12 mois ?",
4, Application.UserName)
If question = 7 Then
Cells(Target.Row + 1, Target.Column) = "NEW": Exit Sub
Else
Application.EnableEvents = False
For lig = 37 To 56 Step 2
If Feuil2.Cells(lig, 2) = "" Then Exit For
Next
If lig > 56 Then MsgBox "complet": Application.EnableEvents
= True: Exit Sub
mycol = Array(0, 2, 5, 20, 32, 35, 37, 39)
For k = 1 To 7
Feuil2.Cells(lig, mycol(k)) = Feuil1.Cells(Target.Row,
mycol(k))
If Feuil1.Range("AB" & Target.Row) = "" Then
Feuil1.Cells(Target.Row, mycol(k)) = ""
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If
'macro plage 4
If Not Intersect(Target, Range("I58:AI58")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?",
4, Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub
Else
For k = 9 To 35 Step 2
If Feuil2.Cells(58, k) = "" Then Feuil2.Cells(58, k) > Target.Value: Exit For
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If
'macro plage 5
If Not Intersect(Target,
Range("AB37,AB39,AB41,AB43,AB45,AB47,AB49,AB51,AB53,AB55")) Is Nothing
Then
If Left(Cells(Target.Row, Target.Column), 2) = "IL" Or
Left(Cells(Target.Row, Target.Column), 1) = "B" Or Left(Cells(Target.Row,
Target.Column), 2) = "1B" Or Left(Cells(Target.Row, Target.Column), 2) =
"2B"
Or Left(Cells(Target.Row, Target.Column), 1) = "L" Or
Left(Cells(Target.Row,
Target.Column), 1) = "J" Or Left(Cells(Target.Row, Target.Column), 2) =
"1J"
Or Left(Cells(Target.Row, Target.Column), 1) = "2J" Then
question = MsgBox("Est-ce un dito ?", vbYesNo,
Application.UserName)
If question = vbYes Then
Cells(Target.Row + 1, Target.Column) = "DITO 2006": Exit Sub
End If
End If
End If
Salut, Ta macro tourne chez moi comme tu le souhaite. La fusion de tes cellules à cet endroit à peut être été modifées Je vois que cette seule solution en fenetre Execution au cas ou... lance cette ligne et <Enter> Application.EnableEvents = True
ici j'ai raccourci le début de la macro, le restant étant inchangé Youky
Dim iSect As Range, c As Range Set iSect = Intersect(Target, Range("ab37:ab56,ba6:cc6,ba16:cc16,af37:af56,i58:ai58")) If Not iSect Is Nothing Then For Each c In iSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(1, 0).ClearContents Application.EnableEvents = True Next End If
If Target.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub
'macro plage 1 et le restant de la macro inchangée
"Nicoh" a écrit dans le message de news:
Bonjour à tous,
Certains d'entre vous (Youky, FxM, Jacky, LSteph, JB, ...) m'ont développé des macros qui misent bout à bout donnent le résultat suivant (voir plus bas). Jusqu'à la semaine dernière tout se passait normalement et aujourd'hui il y a des "fonctions" qui ne sont plus actives. Par exemple, en BA16 si on répond OUI à la question "est-ce un NEW ?", ça marche, mais la question ne se pose plus en BC16 ! Par contre en AF 37 à la même question ça marche et en AF39 ça marche encore ! Quelqu'un peut-il me renseigner sur l'éventuelle manip à faire, c'est trop fort pour moi.
D'avance merci pour votre patience et votre aide.
Ci-dessous la macro : Private Sub Worksheet_Change(ByVal Target As Range)
Dim iSect As Range, jSect As Range, kSect As Range, lSect As Range, mSect As Range, c As Range Set iSect = Intersect(Target, Range("ab37:ab56")) Set jSect = Intersect(Target, Range("ba6:cc6")) Set kSect = Intersect(Target, Range("ba16:cc16")) Set lSect = Intersect(Target, Range("af37:af56")) Set mSect = Intersect(Target, Range("i58:ai58")) If Not iSect Is Nothing Then For Each c In iSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(1, 0).ClearContents Application.EnableEvents = True Next End If If Not jSect Is Nothing Then For Each c In jSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(-1, 0).ClearContents Application.EnableEvents = True Next End If If Not kSect Is Nothing Then For Each c In kSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(-1, 0).ClearContents Application.EnableEvents = True Next End If If Not lSect Is Nothing Then For Each c In lSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(1, 0).ClearContents Application.EnableEvents = True Next End If If Not mSect Is Nothing Then For Each c In mSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(-1, 0).ClearContents Application.EnableEvents = True Next End If
If Target.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub
'macro plage 1
If Not Intersect(Target, Range("ba6:cc6")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", 4, Application.UserName) If question = 7 Then rep = MsgBox("Le texte est-il DITO ?", 4, Application.UserName) If rep = 7 Then [AW8].Select Selection.ClearContents Exit Sub End If Else Application.EnableEvents = False question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row - 1, Target.Column) = "NEW" [AW8].Select Selection.ClearContents Else For k = 53 To 81 Step 2 If Feuil2.Cells(6, k) = "" Then Feuil2.Cells(6, k) = Target.Value: Exit For Next Target.Value = "" End If End If Application.EnableEvents = True End If
'macro plage 2
If Not Intersect(Target, Range("ba16:cc16")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName) If question = vbYes Then Application.EnableEvents = False question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub Else For k = 53 To 81 Step 2 If Feuil2.Cells(16, k) = "" Then Feuil2.Cells(16, k) > Target.Value: Exit For Next Target.Value = "" End If Application.EnableEvents = True End If End If
'macro plage 3
If Not Intersect(Target, Range("AF37,AF39,AF41,AF43,AF45,AF47,AF49,AF51,AF53,AF55")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName) If question = vbYes Then question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row + 1, Target.Column) = "NEW": Exit Sub Else Application.EnableEvents = False For lig = 37 To 56 Step 2 If Feuil2.Cells(lig, 2) = "" Then Exit For Next If lig > 56 Then MsgBox "complet": Application.EnableEvents = True: Exit Sub mycol = Array(0, 2, 5, 20, 32, 35, 37, 39) For k = 1 To 7 Feuil2.Cells(lig, mycol(k)) = Feuil1.Cells(Target.Row, mycol(k)) If Feuil1.Range("AB" & Target.Row) = "" Then Feuil1.Cells(Target.Row, mycol(k)) = "" Next Target.Value = "" End If Application.EnableEvents = True End If End If
'macro plage 4
If Not Intersect(Target, Range("I58:AI58")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName) If question = vbYes Then Application.EnableEvents = False question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub Else For k = 9 To 35 Step 2 If Feuil2.Cells(58, k) = "" Then Feuil2.Cells(58, k) > Target.Value: Exit For Next Target.Value = "" End If Application.EnableEvents = True End If End If
'macro plage 5
If Not Intersect(Target, Range("AB37,AB39,AB41,AB43,AB45,AB47,AB49,AB51,AB53,AB55")) Is Nothing Then If Left(Cells(Target.Row, Target.Column), 2) = "IL" Or Left(Cells(Target.Row, Target.Column), 1) = "B" Or Left(Cells(Target.Row, Target.Column), 2) = "1B" Or Left(Cells(Target.Row, Target.Column), 2) = "2B" Or Left(Cells(Target.Row, Target.Column), 1) = "L" Or Left(Cells(Target.Row, Target.Column), 1) = "J" Or Left(Cells(Target.Row, Target.Column), 2) = "1J" Or Left(Cells(Target.Row, Target.Column), 1) = "2J" Then question = MsgBox("Est-ce un dito ?", vbYesNo, Application.UserName) If question = vbYes Then Cells(Target.Row + 1, Target.Column) = "DITO 2006": Exit Sub End If End If End If
End Sub
Nicoh
Salut,
Merci de ta réponse. En fait, j'ai résolu le problème en enlevant Exit Sub dans les plages concernées et pour le moment tout fonctionne parfaitement. Je suppose qu'il y aura un problème plus tard car Exit Sub doit servir à qqch, mais j'improviserais à ce moment là. Par contre, je vais changer le début dès que j'ai un peu de temps (c'est la course aujourd'hui) comme tu l'as fait et te tiens au courant si pb par ton mail perso comme la fois dernière.
En tout cas encore merci beaucoup pour ton aide,
Nicoh
Salut, Ta macro tourne chez moi comme tu le souhaite. La fusion de tes cellules à cet endroit à peut être été modifées Je vois que cette seule solution en fenetre Execution au cas ou... lance cette ligne et <Enter> Application.EnableEvents = True
ici j'ai raccourci le début de la macro, le restant étant inchangé Youky
Dim iSect As Range, c As Range Set iSect = Intersect(Target, Range("ab37:ab56,ba6:cc6,ba16:cc16,af37:af56,i58:ai58")) If Not iSect Is Nothing Then For Each c In iSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(1, 0).ClearContents Application.EnableEvents = True Next End If
If Target.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub
'macro plage 1 et le restant de la macro inchangée
"Nicoh" a écrit dans le message de news:
Bonjour à tous,
Certains d'entre vous (Youky, FxM, Jacky, LSteph, JB, ...) m'ont développé des macros qui misent bout à bout donnent le résultat suivant (voir plus bas). Jusqu'à la semaine dernière tout se passait normalement et aujourd'hui il y a des "fonctions" qui ne sont plus actives. Par exemple, en BA16 si on répond OUI à la question "est-ce un NEW ?", ça marche, mais la question ne se pose plus en BC16 ! Par contre en AF 37 à la même question ça marche et en AF39 ça marche encore ! Quelqu'un peut-il me renseigner sur l'éventuelle manip à faire, c'est trop fort pour moi.
D'avance merci pour votre patience et votre aide.
Ci-dessous la macro : Private Sub Worksheet_Change(ByVal Target As Range)
Dim iSect As Range, jSect As Range, kSect As Range, lSect As Range, mSect As Range, c As Range Set iSect = Intersect(Target, Range("ab37:ab56")) Set jSect = Intersect(Target, Range("ba6:cc6")) Set kSect = Intersect(Target, Range("ba16:cc16")) Set lSect = Intersect(Target, Range("af37:af56")) Set mSect = Intersect(Target, Range("i58:ai58")) If Not iSect Is Nothing Then For Each c In iSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(1, 0).ClearContents Application.EnableEvents = True Next End If If Not jSect Is Nothing Then For Each c In jSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(-1, 0).ClearContents Application.EnableEvents = True Next End If If Not kSect Is Nothing Then For Each c In kSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(-1, 0).ClearContents Application.EnableEvents = True Next End If If Not lSect Is Nothing Then For Each c In lSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(1, 0).ClearContents Application.EnableEvents = True Next End If If Not mSect Is Nothing Then For Each c In mSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(-1, 0).ClearContents Application.EnableEvents = True Next End If
If Target.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub
'macro plage 1
If Not Intersect(Target, Range("ba6:cc6")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", 4, Application.UserName) If question = 7 Then rep = MsgBox("Le texte est-il DITO ?", 4, Application.UserName) If rep = 7 Then [AW8].Select Selection.ClearContents Exit Sub End If Else Application.EnableEvents = False question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row - 1, Target.Column) = "NEW" [AW8].Select Selection.ClearContents Else For k = 53 To 81 Step 2 If Feuil2.Cells(6, k) = "" Then Feuil2.Cells(6, k) = Target.Value: Exit For Next Target.Value = "" End If End If Application.EnableEvents = True End If
'macro plage 2
If Not Intersect(Target, Range("ba16:cc16")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName) If question = vbYes Then Application.EnableEvents = False question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub Else For k = 53 To 81 Step 2 If Feuil2.Cells(16, k) = "" Then Feuil2.Cells(16, k) > > Target.Value: Exit For Next Target.Value = "" End If Application.EnableEvents = True End If End If
'macro plage 3
If Not Intersect(Target, Range("AF37,AF39,AF41,AF43,AF45,AF47,AF49,AF51,AF53,AF55")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName) If question = vbYes Then question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row + 1, Target.Column) = "NEW": Exit Sub Else Application.EnableEvents = False For lig = 37 To 56 Step 2 If Feuil2.Cells(lig, 2) = "" Then Exit For Next If lig > 56 Then MsgBox "complet": Application.EnableEvents = True: Exit Sub mycol = Array(0, 2, 5, 20, 32, 35, 37, 39) For k = 1 To 7 Feuil2.Cells(lig, mycol(k)) = Feuil1.Cells(Target.Row, mycol(k)) If Feuil1.Range("AB" & Target.Row) = "" Then Feuil1.Cells(Target.Row, mycol(k)) = "" Next Target.Value = "" End If Application.EnableEvents = True End If End If
'macro plage 4
If Not Intersect(Target, Range("I58:AI58")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName) If question = vbYes Then Application.EnableEvents = False question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub Else For k = 9 To 35 Step 2 If Feuil2.Cells(58, k) = "" Then Feuil2.Cells(58, k) > > Target.Value: Exit For Next Target.Value = "" End If Application.EnableEvents = True End If End If
'macro plage 5
If Not Intersect(Target, Range("AB37,AB39,AB41,AB43,AB45,AB47,AB49,AB51,AB53,AB55")) Is Nothing Then If Left(Cells(Target.Row, Target.Column), 2) = "IL" Or Left(Cells(Target.Row, Target.Column), 1) = "B" Or Left(Cells(Target.Row, Target.Column), 2) = "1B" Or Left(Cells(Target.Row, Target.Column), 2) = "2B" Or Left(Cells(Target.Row, Target.Column), 1) = "L" Or Left(Cells(Target.Row, Target.Column), 1) = "J" Or Left(Cells(Target.Row, Target.Column), 2) = "1J" Or Left(Cells(Target.Row, Target.Column), 1) = "2J" Then question = MsgBox("Est-ce un dito ?", vbYesNo, Application.UserName) If question = vbYes Then Cells(Target.Row + 1, Target.Column) = "DITO 2006": Exit Sub End If End If End If
End Sub
Salut,
Merci de ta réponse. En fait, j'ai résolu le problème en enlevant Exit Sub
dans les plages concernées et pour le moment tout fonctionne parfaitement. Je
suppose qu'il y aura un problème plus tard car Exit Sub doit servir à qqch,
mais j'improviserais à ce moment là.
Par contre, je vais changer le début dès que j'ai un peu de temps (c'est la
course aujourd'hui) comme tu l'as fait et te tiens au courant si pb par ton
mail perso comme la fois dernière.
En tout cas encore merci beaucoup pour ton aide,
Nicoh
Salut,
Ta macro tourne chez moi comme tu le souhaite.
La fusion de tes cellules à cet endroit à peut être été modifées
Je vois que cette seule solution
en fenetre Execution au cas ou... lance cette ligne et <Enter>
Application.EnableEvents = True
ici j'ai raccourci le début de la macro, le restant étant inchangé
Youky
Dim iSect As Range, c As Range
Set iSect = Intersect(Target,
Range("ab37:ab56,ba6:cc6,ba16:cc16,af37:af56,i58:ai58"))
If Not iSect Is Nothing Then
For Each c In iSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
'macro plage 1
et le restant de la macro inchangée
"Nicoh" <Nicoh@discussions.microsoft.com> a écrit dans le message de news:
57D330B2-F849-4E99-A67D-C4140A2F19BA@microsoft.com...
Bonjour à tous,
Certains d'entre vous (Youky, FxM, Jacky, LSteph, JB, ...) m'ont développé
des macros qui misent bout à bout donnent le résultat suivant (voir plus
bas). Jusqu'à la semaine dernière tout se passait normalement et
aujourd'hui
il y a des "fonctions" qui ne sont plus actives.
Par exemple, en BA16 si on répond OUI à la question "est-ce un NEW ?", ça
marche, mais la question ne se pose plus en BC16 !
Par contre en AF 37 à la même question ça marche et en AF39 ça marche
encore !
Quelqu'un peut-il me renseigner sur l'éventuelle manip à faire, c'est trop
fort pour moi.
D'avance merci pour votre patience et votre aide.
Ci-dessous la macro :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iSect As Range, jSect As Range, kSect As Range, lSect As Range, mSect
As
Range, c As Range
Set iSect = Intersect(Target, Range("ab37:ab56"))
Set jSect = Intersect(Target, Range("ba6:cc6"))
Set kSect = Intersect(Target, Range("ba16:cc16"))
Set lSect = Intersect(Target, Range("af37:af56"))
Set mSect = Intersect(Target, Range("i58:ai58"))
If Not iSect Is Nothing Then
For Each c In iSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not jSect Is Nothing Then
For Each c In jSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not kSect Is Nothing Then
For Each c In kSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not lSect Is Nothing Then
For Each c In lSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not mSect Is Nothing Then
For Each c In mSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
'macro plage 1
If Not Intersect(Target, Range("ba6:cc6")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", 4, Application.UserName)
If question = 7 Then
rep = MsgBox("Le texte est-il DITO ?", 4, Application.UserName)
If rep = 7 Then
[AW8].Select
Selection.ClearContents
Exit Sub
End If
Else
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4,
Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW"
[AW8].Select
Selection.ClearContents
Else
For k = 53 To 81 Step 2
If Feuil2.Cells(6, k) = "" Then Feuil2.Cells(6, k) = Target.Value:
Exit
For
Next
Target.Value = ""
End If
End If
Application.EnableEvents = True
End If
'macro plage 2
If Not Intersect(Target, Range("ba16:cc16")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4,
Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub
Else
For k = 53 To 81 Step 2
If Feuil2.Cells(16, k) = "" Then Feuil2.Cells(16, k) > > Target.Value: Exit For
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If
'macro plage 3
If Not Intersect(Target,
Range("AF37,AF39,AF41,AF43,AF45,AF47,AF49,AF51,AF53,AF55")) Is Nothing
Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
question = MsgBox("La facturation se fait-elle sur 12 mois ?",
4, Application.UserName)
If question = 7 Then
Cells(Target.Row + 1, Target.Column) = "NEW": Exit Sub
Else
Application.EnableEvents = False
For lig = 37 To 56 Step 2
If Feuil2.Cells(lig, 2) = "" Then Exit For
Next
If lig > 56 Then MsgBox "complet": Application.EnableEvents
= True: Exit Sub
mycol = Array(0, 2, 5, 20, 32, 35, 37, 39)
For k = 1 To 7
Feuil2.Cells(lig, mycol(k)) = Feuil1.Cells(Target.Row,
mycol(k))
If Feuil1.Range("AB" & Target.Row) = "" Then
Feuil1.Cells(Target.Row, mycol(k)) = ""
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If
'macro plage 4
If Not Intersect(Target, Range("I58:AI58")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?",
4, Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub
Else
For k = 9 To 35 Step 2
If Feuil2.Cells(58, k) = "" Then Feuil2.Cells(58, k) > > Target.Value: Exit For
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If
'macro plage 5
If Not Intersect(Target,
Range("AB37,AB39,AB41,AB43,AB45,AB47,AB49,AB51,AB53,AB55")) Is Nothing
Then
If Left(Cells(Target.Row, Target.Column), 2) = "IL" Or
Left(Cells(Target.Row, Target.Column), 1) = "B" Or Left(Cells(Target.Row,
Target.Column), 2) = "1B" Or Left(Cells(Target.Row, Target.Column), 2) =
"2B"
Or Left(Cells(Target.Row, Target.Column), 1) = "L" Or
Left(Cells(Target.Row,
Target.Column), 1) = "J" Or Left(Cells(Target.Row, Target.Column), 2) =
"1J"
Or Left(Cells(Target.Row, Target.Column), 1) = "2J" Then
question = MsgBox("Est-ce un dito ?", vbYesNo,
Application.UserName)
If question = vbYes Then
Cells(Target.Row + 1, Target.Column) = "DITO 2006": Exit Sub
End If
End If
End If
Merci de ta réponse. En fait, j'ai résolu le problème en enlevant Exit Sub dans les plages concernées et pour le moment tout fonctionne parfaitement. Je suppose qu'il y aura un problème plus tard car Exit Sub doit servir à qqch, mais j'improviserais à ce moment là. Par contre, je vais changer le début dès que j'ai un peu de temps (c'est la course aujourd'hui) comme tu l'as fait et te tiens au courant si pb par ton mail perso comme la fois dernière.
En tout cas encore merci beaucoup pour ton aide,
Nicoh
Salut, Ta macro tourne chez moi comme tu le souhaite. La fusion de tes cellules à cet endroit à peut être été modifées Je vois que cette seule solution en fenetre Execution au cas ou... lance cette ligne et <Enter> Application.EnableEvents = True
ici j'ai raccourci le début de la macro, le restant étant inchangé Youky
Dim iSect As Range, c As Range Set iSect = Intersect(Target, Range("ab37:ab56,ba6:cc6,ba16:cc16,af37:af56,i58:ai58")) If Not iSect Is Nothing Then For Each c In iSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(1, 0).ClearContents Application.EnableEvents = True Next End If
If Target.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub
'macro plage 1 et le restant de la macro inchangée
"Nicoh" a écrit dans le message de news:
Bonjour à tous,
Certains d'entre vous (Youky, FxM, Jacky, LSteph, JB, ...) m'ont développé des macros qui misent bout à bout donnent le résultat suivant (voir plus bas). Jusqu'à la semaine dernière tout se passait normalement et aujourd'hui il y a des "fonctions" qui ne sont plus actives. Par exemple, en BA16 si on répond OUI à la question "est-ce un NEW ?", ça marche, mais la question ne se pose plus en BC16 ! Par contre en AF 37 à la même question ça marche et en AF39 ça marche encore ! Quelqu'un peut-il me renseigner sur l'éventuelle manip à faire, c'est trop fort pour moi.
D'avance merci pour votre patience et votre aide.
Ci-dessous la macro : Private Sub Worksheet_Change(ByVal Target As Range)
Dim iSect As Range, jSect As Range, kSect As Range, lSect As Range, mSect As Range, c As Range Set iSect = Intersect(Target, Range("ab37:ab56")) Set jSect = Intersect(Target, Range("ba6:cc6")) Set kSect = Intersect(Target, Range("ba16:cc16")) Set lSect = Intersect(Target, Range("af37:af56")) Set mSect = Intersect(Target, Range("i58:ai58")) If Not iSect Is Nothing Then For Each c In iSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(1, 0).ClearContents Application.EnableEvents = True Next End If If Not jSect Is Nothing Then For Each c In jSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(-1, 0).ClearContents Application.EnableEvents = True Next End If If Not kSect Is Nothing Then For Each c In kSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(-1, 0).ClearContents Application.EnableEvents = True Next End If If Not lSect Is Nothing Then For Each c In lSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(1, 0).ClearContents Application.EnableEvents = True Next End If If Not mSect Is Nothing Then For Each c In mSect.Cells Application.EnableEvents = False If c.Value = "" Then _ c.Offset(-1, 0).ClearContents Application.EnableEvents = True Next End If
If Target.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub
'macro plage 1
If Not Intersect(Target, Range("ba6:cc6")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", 4, Application.UserName) If question = 7 Then rep = MsgBox("Le texte est-il DITO ?", 4, Application.UserName) If rep = 7 Then [AW8].Select Selection.ClearContents Exit Sub End If Else Application.EnableEvents = False question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row - 1, Target.Column) = "NEW" [AW8].Select Selection.ClearContents Else For k = 53 To 81 Step 2 If Feuil2.Cells(6, k) = "" Then Feuil2.Cells(6, k) = Target.Value: Exit For Next Target.Value = "" End If End If Application.EnableEvents = True End If
'macro plage 2
If Not Intersect(Target, Range("ba16:cc16")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName) If question = vbYes Then Application.EnableEvents = False question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub Else For k = 53 To 81 Step 2 If Feuil2.Cells(16, k) = "" Then Feuil2.Cells(16, k) > > Target.Value: Exit For Next Target.Value = "" End If Application.EnableEvents = True End If End If
'macro plage 3
If Not Intersect(Target, Range("AF37,AF39,AF41,AF43,AF45,AF47,AF49,AF51,AF53,AF55")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName) If question = vbYes Then question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row + 1, Target.Column) = "NEW": Exit Sub Else Application.EnableEvents = False For lig = 37 To 56 Step 2 If Feuil2.Cells(lig, 2) = "" Then Exit For Next If lig > 56 Then MsgBox "complet": Application.EnableEvents = True: Exit Sub mycol = Array(0, 2, 5, 20, 32, 35, 37, 39) For k = 1 To 7 Feuil2.Cells(lig, mycol(k)) = Feuil1.Cells(Target.Row, mycol(k)) If Feuil1.Range("AB" & Target.Row) = "" Then Feuil1.Cells(Target.Row, mycol(k)) = "" Next Target.Value = "" End If Application.EnableEvents = True End If End If
'macro plage 4
If Not Intersect(Target, Range("I58:AI58")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName) If question = vbYes Then Application.EnableEvents = False question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4, Application.UserName) If question = 7 Then Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub Else For k = 9 To 35 Step 2 If Feuil2.Cells(58, k) = "" Then Feuil2.Cells(58, k) > > Target.Value: Exit For Next Target.Value = "" End If Application.EnableEvents = True End If End If
'macro plage 5
If Not Intersect(Target, Range("AB37,AB39,AB41,AB43,AB45,AB47,AB49,AB51,AB53,AB55")) Is Nothing Then If Left(Cells(Target.Row, Target.Column), 2) = "IL" Or Left(Cells(Target.Row, Target.Column), 1) = "B" Or Left(Cells(Target.Row, Target.Column), 2) = "1B" Or Left(Cells(Target.Row, Target.Column), 2) = "2B" Or Left(Cells(Target.Row, Target.Column), 1) = "L" Or Left(Cells(Target.Row, Target.Column), 1) = "J" Or Left(Cells(Target.Row, Target.Column), 2) = "1J" Or Left(Cells(Target.Row, Target.Column), 1) = "2J" Then question = MsgBox("Est-ce un dito ?", vbYesNo, Application.UserName) If question = vbYes Then Cells(Target.Row + 1, Target.Column) = "DITO 2006": Exit Sub End If End If End If
