• Initiateur de la discussion Initiateur de la discussion isa44
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

isa44

XLDnaute Occasionnel
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
 
Re : Problème de BUG

Bonsoir,
c'est normal, lorsque tu identes ton code, tu verras ceci :

Code:
With Sheets("Signalements")
    .Activate
    .Range("A1").Select
        [COLOR="Green"]With[/COLOR] .Range("G" & DerLigne)
            [COLOR="Red"]With[/COLOR] .Font
                .Name = MyCellFont
                .Color = MyCellFontColor
                .Bold = MyCellBold
                .Italic = MyCellItalic
            [COLOR="Red"]End With[/COLOR]
            .Value = MyCellValue
        [COLOR="Green"]End With[/COLOR]
    .Range("A" & DerLigne) = TextBox3.Value

donc si tu supprimes le End With en vert, tu auras tes données en colonne "G"
 
Re : Problème de BUG

Merci bhbh,
celà ne résoud pas mon problème .

Voici un lien où j'ai déposé le dit fichier trop lourd avec les explications :

http://cjoint.com/?dlsTUJzce1.

Je tente encore de le corriger , mais j'ai les neurones qui commencent à chauffer !!!!
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 modifier un code
Réponses
1
Affichages
425
Réponses
3
Affichages
568
Réponses
18
Affichages
687
Retour