Je souhaite intégrer au code qui suit le fait que la feuille active se copie
quand la réponse à la quesiton "la facturation se fait-elle sur 12 mois ?"est
oui.
Par contre, la feuille ne doit se copier qu'une seule fois et non pas autant
de fois que l'on répond oui à la question.
Autrement dit, la feuille doit se copier la première fois que l'on répond à
la question qui sera posée quand on renseigne une quelconque cellule des
plages suivantes : BA6:CC6 ou BA16:CC16 ou I58:AI58 ou
"AF37,AF39,AF41,AF43,AF45,AF47,AF49,AF51,AF53,AF55"
J'utilise le code suivant :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("ba6:cc6")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", 4, Application.UserName)
If question = 7 Then
question = MsgBox("Le texte est-il DITO ?", 4, Application.UserName)
If question = 7 Then
[AW8].Select
Exit Sub
End If
Else
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"
[AW8].Select
End If
End If
End If
End If
If Not Intersect(Target, Range("ba16:cc16")) 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
End If
End If
End If
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
End If
End If
End If
If Not Intersect(Target, Range("I58:AI58")) 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
End If
End If
End If
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
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
Elliac
Bonjour,
A adapter à ton problème, cette macro copie la feuille active si elle n'a jamais été copiée et si on répond oui à la demande de copie. Elle peut être accompagnée d'un code à l'ouverture du fichier qui remettrait la cellule A1 de la feuille 3 à vide :
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" And Sheets(3).Range("a1") <> "Oui" Then rep = MsgBox("voulez-vous copier cette feuille", vbYesNo) If rep = vbYes Then Sheets(3).Range("a1") = "Oui" ActiveSheet.Copy End If End If End Sub
Camille
"Nicoh" wrote:
Bonsoir à tous,
Je souhaite intégrer au code qui suit le fait que la feuille active se copie quand la réponse à la quesiton "la facturation se fait-elle sur 12 mois ?"est oui. Par contre, la feuille ne doit se copier qu'une seule fois et non pas autant de fois que l'on répond oui à la question. Autrement dit, la feuille doit se copier la première fois que l'on répond à la question qui sera posée quand on renseigne une quelconque cellule des plages suivantes : BA6:CC6 ou BA16:CC16 ou I58:AI58 ou "AF37,AF39,AF41,AF43,AF45,AF47,AF49,AF51,AF53,AF55"
J'utilise le code suivant :
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("ba6:cc6")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", 4, Application.UserName) If question = 7 Then question = MsgBox("Le texte est-il DITO ?", 4, Application.UserName) If question = 7 Then [AW8].Select Exit Sub End If Else 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" [AW8].Select End If End If End If End If
If Not Intersect(Target, Range("ba16:cc16")) 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 End If End If End If
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 End If End If End If
If Not Intersect(Target, Range("I58:AI58")) 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 End If End If End If
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
D'avance merci pour votre contribution.
Nicoh
Bonjour,
A adapter à ton problème, cette macro copie la feuille active si elle n'a
jamais été copiée et si on répond oui à la demande de copie. Elle peut être
accompagnée d'un code à l'ouverture du fichier qui remettrait la cellule A1
de la feuille 3 à vide :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" And Sheets(3).Range("a1") <> "Oui" Then
rep = MsgBox("voulez-vous copier cette feuille", vbYesNo)
If rep = vbYes Then
Sheets(3).Range("a1") = "Oui"
ActiveSheet.Copy
End If
End If
End Sub
Camille
"Nicoh" wrote:
Bonsoir à tous,
Je souhaite intégrer au code qui suit le fait que la feuille active se copie
quand la réponse à la quesiton "la facturation se fait-elle sur 12 mois ?"est
oui.
Par contre, la feuille ne doit se copier qu'une seule fois et non pas autant
de fois que l'on répond oui à la question.
Autrement dit, la feuille doit se copier la première fois que l'on répond à
la question qui sera posée quand on renseigne une quelconque cellule des
plages suivantes : BA6:CC6 ou BA16:CC16 ou I58:AI58 ou
"AF37,AF39,AF41,AF43,AF45,AF47,AF49,AF51,AF53,AF55"
J'utilise le code suivant :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("ba6:cc6")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", 4, Application.UserName)
If question = 7 Then
question = MsgBox("Le texte est-il DITO ?", 4, Application.UserName)
If question = 7 Then
[AW8].Select
Exit Sub
End If
Else
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"
[AW8].Select
End If
End If
End If
End If
If Not Intersect(Target, Range("ba16:cc16")) 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
End If
End If
End If
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
End If
End If
End If
If Not Intersect(Target, Range("I58:AI58")) 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
End If
End If
End If
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
A adapter à ton problème, cette macro copie la feuille active si elle n'a jamais été copiée et si on répond oui à la demande de copie. Elle peut être accompagnée d'un code à l'ouverture du fichier qui remettrait la cellule A1 de la feuille 3 à vide :
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" And Sheets(3).Range("a1") <> "Oui" Then rep = MsgBox("voulez-vous copier cette feuille", vbYesNo) If rep = vbYes Then Sheets(3).Range("a1") = "Oui" ActiveSheet.Copy End If End If End Sub
Camille
"Nicoh" wrote:
Bonsoir à tous,
Je souhaite intégrer au code qui suit le fait que la feuille active se copie quand la réponse à la quesiton "la facturation se fait-elle sur 12 mois ?"est oui. Par contre, la feuille ne doit se copier qu'une seule fois et non pas autant de fois que l'on répond oui à la question. Autrement dit, la feuille doit se copier la première fois que l'on répond à la question qui sera posée quand on renseigne une quelconque cellule des plages suivantes : BA6:CC6 ou BA16:CC16 ou I58:AI58 ou "AF37,AF39,AF41,AF43,AF45,AF47,AF49,AF51,AF53,AF55"
J'utilise le code suivant :
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("ba6:cc6")) Is Nothing Then question = MsgBox("Est-ce un NEW ?", 4, Application.UserName) If question = 7 Then question = MsgBox("Le texte est-il DITO ?", 4, Application.UserName) If question = 7 Then [AW8].Select Exit Sub End If Else 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" [AW8].Select End If End If End If End If
If Not Intersect(Target, Range("ba16:cc16")) 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 End If End If End If
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 End If End If End If
If Not Intersect(Target, Range("I58:AI58")) 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 End If End If End If
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
