Bonsoir à tous , un nouveau problème s'affronte à mon classeur :
Lorsque j'active le commandbutton 1, les valeurs se copient dans les feuilles suivantes.
Quand je retire le texte en rouge : plus de copie dans les feuilles suivantes mais se copient en ligne17 et à partir dela colonne G !!!
Private Sub CommandButton1_Click()
Dim DerLigne As Integer
DerLigne = Sheets("Signalements").Range("A65536").End(xlUp).Row + 1
With Sheets("Signalements")
.Activate
.Range("A1").Select
With .Range("G" & DerLigne)
With .Font
.Name = MyCellFont
.Color = MyCellFontColor
.Bold = MyCellBold
.Italic = MyCellItalic
End With
.Value = MyCellValue
End With.Range("A" & DerLigne) = TextBox3.Value
.Range("B" & DerLigne) = TextBox2.Value
.Range("C" & DerLigne) = TextBox1.Value
.Range("E" & DerLigne) = Format(TextBox4, "000")
.Range("F" & DerLigne) = Format(TextBox9, "00 00")
.Range("G" & DerLigne) = Format(Me.TextBox38, "## ##")
.Range("I" & DerLigne) = Format(TextBox12, "00 h 00")
.Range("H" & DerLigne) = Format(TextBox13, "00 h 00")
.Range("J" & DerLigne) = TextBox8
TextBox4.Value = ""
TextBox8.Value = ""
TextBox9.Value = ""
TextBox12.Value = ""
TextBox13.Value = ""
TextBox4.SetFocus
TextBox12.SetFocus
TextBox13.SetFocus
TextBox8.SetFocus
TextBox4.SetFocus
End With
End Sub
Voici le code inscrit dans le workbook :
Option Explicit
Dim MaValeur As Variant
Private Flag As Boolean
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Flag Then Exit Sub
Flag = True
If Flag And Not Intersect(Target, Range("C6:C26,H6:H30,M6:M37,R6:R39")) Is Nothing Then
Target.Offset(0, 1) = MaValeur
End If
Flag = True
If Target.Address = "$C$6" Then
Sheets("ROSE").Range("C6") = Target.Value
Sheets("VERT").Range("C6") = Target.Value
Sheets("BLEU").Range("C6") = Target.Value
Sheets("JAUNE").Range("C6") = Target.Value
End If
If Target.Address = "$C$7" Then
Sheets("ROSE").Range("C7") = Target.Value
Sheets("VERT").Range("C7") = Target.Value
Sheets("BLEU").Range("C7") = Target.Value
Sheets("JAUNE").Range("C7") = Target.Value
End If
If Target.Address = "$C$8" Then
Sheets("ROSE").Range("C8") = Target.Value
Sheets("VERT").Range("C8") = Target.Value
Sheets("BLEU").Range("C8") = Target.Value
Sheets("JAUNE").Range("C8") = Target.Value
End If
If Target.Address = "$H$6" Then
Sheets("ROSE").Range("H6") = Target.Value
Sheets("VERT").Range("H6") = Target.Value
Sheets("BLEU").Range("H6") = Target.Value
Sheets("JAUNE").Range("H6") = Target.Value
End If
If Target.Address = "$M$8" Then
Sheets("ROSE").Range("M8") = Target.Value
Sheets("VERT").Range("M8") = Target.Value
Sheets("BLEU").Range("M8") = Target.Value
Sheets("JAUNE").Range("M8") = Target.Value
End If
If Target.Address = "$R$6" Then
Sheets("ROSE").Range("R6") = Target.Value
Sheets("VERT").Range("R6") = Target.Value
Sheets("BLEU").Range("R6") = Target.Value
Sheets("JAUNE").Range("R6") = Target.Value
End If
Flag = False
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("C6:C26,H6:H30,M6:M37,R6:R39")) Is Nothing Then
MaValeur = Target.Value
End If
End Sub
Lorsque j'active le commandbutton 1, les valeurs se copient dans les feuilles suivantes.
Quand je retire le texte en rouge : plus de copie dans les feuilles suivantes mais se copient en ligne17 et à partir dela colonne G !!!
Private Sub CommandButton1_Click()
Dim DerLigne As Integer
DerLigne = Sheets("Signalements").Range("A65536").End(xlUp).Row + 1
With Sheets("Signalements")
.Activate
.Range("A1").Select
With .Range("G" & DerLigne)
With .Font
.Name = MyCellFont
.Color = MyCellFontColor
.Bold = MyCellBold
.Italic = MyCellItalic
End With
.Value = MyCellValue
End With.Range("A" & DerLigne) = TextBox3.Value
.Range("B" & DerLigne) = TextBox2.Value
.Range("C" & DerLigne) = TextBox1.Value
.Range("E" & DerLigne) = Format(TextBox4, "000")
.Range("F" & DerLigne) = Format(TextBox9, "00 00")
.Range("G" & DerLigne) = Format(Me.TextBox38, "## ##")
.Range("I" & DerLigne) = Format(TextBox12, "00 h 00")
.Range("H" & DerLigne) = Format(TextBox13, "00 h 00")
.Range("J" & DerLigne) = TextBox8
TextBox4.Value = ""
TextBox8.Value = ""
TextBox9.Value = ""
TextBox12.Value = ""
TextBox13.Value = ""
TextBox4.SetFocus
TextBox12.SetFocus
TextBox13.SetFocus
TextBox8.SetFocus
TextBox4.SetFocus
End With
End Sub
Voici le code inscrit dans le workbook :
Option Explicit
Dim MaValeur As Variant
Private Flag As Boolean
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Flag Then Exit Sub
Flag = True
If Flag And Not Intersect(Target, Range("C6:C26,H6:H30,M6:M37,R6:R39")) Is Nothing Then
Target.Offset(0, 1) = MaValeur
End If
Flag = True
If Target.Address = "$C$6" Then
Sheets("ROSE").Range("C6") = Target.Value
Sheets("VERT").Range("C6") = Target.Value
Sheets("BLEU").Range("C6") = Target.Value
Sheets("JAUNE").Range("C6") = Target.Value
End If
If Target.Address = "$C$7" Then
Sheets("ROSE").Range("C7") = Target.Value
Sheets("VERT").Range("C7") = Target.Value
Sheets("BLEU").Range("C7") = Target.Value
Sheets("JAUNE").Range("C7") = Target.Value
End If
If Target.Address = "$C$8" Then
Sheets("ROSE").Range("C8") = Target.Value
Sheets("VERT").Range("C8") = Target.Value
Sheets("BLEU").Range("C8") = Target.Value
Sheets("JAUNE").Range("C8") = Target.Value
End If
If Target.Address = "$H$6" Then
Sheets("ROSE").Range("H6") = Target.Value
Sheets("VERT").Range("H6") = Target.Value
Sheets("BLEU").Range("H6") = Target.Value
Sheets("JAUNE").Range("H6") = Target.Value
End If
If Target.Address = "$M$8" Then
Sheets("ROSE").Range("M8") = Target.Value
Sheets("VERT").Range("M8") = Target.Value
Sheets("BLEU").Range("M8") = Target.Value
Sheets("JAUNE").Range("M8") = Target.Value
End If
If Target.Address = "$R$6" Then
Sheets("ROSE").Range("R6") = Target.Value
Sheets("VERT").Range("R6") = Target.Value
Sheets("BLEU").Range("R6") = Target.Value
Sheets("JAUNE").Range("R6") = Target.Value
End If
Flag = False
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("C6:C26,H6:H30,M6:M37,R6:R39")) Is Nothing Then
MaValeur = Target.Value
End If
End Sub