[XL-2007] Création de feuille

[apt]

Bonsoir à tous,

J'utilise un USF pour entrer des données dans la feuil1.

Ces données seront ajoutés dans la feuil1 d'une part en plus elles seront ajoutée aussi dans une feuille selon le textbox6 (Service).

Si la feuille correspondante à la valeur du TextBox6 n'existe pas, elle sera créée avec les étapes suivantes :

1 - Création de la nouvelle feuille avec le même nom du TextBox6 (Service)

2 - Masquage de la grille

3 - Application d'une MFC

4 - Copiage des entêtes

5 -Insertion des nouvelles données saisies dans l’USF.

Mais voila je rencontre un problème.

Parfois, la nouvelle feuille est créée normalement avec tous ce je viens de décrire (les 5 points), parfois la feuille n'ait créée qu'avec le nom approprié et rien de plus (1er point seulement).

Voila le code utilisé :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
Dim myCon
Private Sub CommandButton1_Click()
    On Error Resume Next
    Dim R As Integer, N As Integer, Endrow As Integer, LastRow As Long
    Dim Sh As Worksheet, F As Worksheet, Tmn As Boolean, Tmp As String
 
 
    Set F = Sheets("Feuil1")
 
    Tmp = TextBox6.Value
    Tmn = False
    For i = 1 To Sheets.Count
        If Sheets(i).Name = Tmp Then Tmn = True
 
    Next i
 
    If Not Tmn Then
        '-- Création feuille de la feuille Tmp
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = Tmp
        MsgBox "Copiage des entetes : "
        F.Range("A1:F1").Copy Sheets(Tmp).Range("A1")
 
        '-- Masquage de la grille
        ActiveWindow.DisplayGridlines = False
 
        ''''--------------------------------- MFC --------------
        '-- Création du MFC
        With Sheets(Tmp).Range("A2:F10000")
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:= _
                                  "=ET(LIGNE();$A1<>"""")"
            With .FormatConditions(1)
                With .Borders
                    .LineStyle = xlContinuous
                    .Weight = xlHairline
                    .ColorIndex = xlAutomatic     '6
                End With
            End With
        End With
    Else
        '-- On selectionne la feuille Tmp si elle existe
 Sheets(Tmp).Select
    End If
 
    '-- Police
    With Sheets(Tmp)
        With .Cells
            With .Font
                .Name = "Calibri"
                .Size = 11
                .ColorIndex = xlAutomatic
            End With
        End With
    End With
 
    Set Sh = Sheets(Tmp)
    LastRow = Sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
 
    For R = 0 To 5
        If Me.Controls(myCon(R)).Text = "" Then N = N + 1
    Next
    For i = 2 To 50000
        If Feuil1.Cells(i, 1).Value = Val(TextBox1.Value) And Feuil1.Cells(i, 2).Value = Val(TextBox2) Then
            MsgBox (Feuil1.Cells(i, 3).Text & "" & ":" & " >>>>>: Doublons   "), 16, "Doublons"
            Exit Sub
            Else
        End If
    Next i
    If N <> 0 Then MsgBox "Entrée manquantes": GoTo 1
    Me.MousePointer = 11
    With Sheets("Feuil1")
        Endrow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
        For R = 0 To 5
            .Cells(Endrow, R + 1).Value = Me.Controls(myCon(R)).Value
            If TextBox6.Value = Sh.Name Then
            End If
        Next R
    End With
    H_A
    ActiveWorkbook.Save
    Me.MousePointer = 0
 
    MsgBox "Entrée réussi"
1 End Sub
 
Private Sub UserForm_Activate()
    myCon = Array("TextBox1", "TextBox2", "TextBox3", "TextBox4", "TextBox5", "TextBox6")
    H_A
End Sub
 
Private Sub H_A()
    Dim RR As Integer, Endrow As Integer
    ComboBox1.Clear
    With Sheets("Feuil1")
        Endrow = .Range("E" & .Rows.Count).End(xlUp).Row
        MsgBox "EndRow  = " & Endrow
        For RR = 2 To Endrow
            ComboBox1.AddItem .Cells(RR, 1).Value
        Next RR
    End With
    For R = 0 To 5
        Me.Controls(myCon(R)) = ""
    Next
    ComboBox1.Value = ""
    CommandButton1.Enabled = True
    TextBox1.Value = Endrow
    TextBox2.SetFocus
End Sub

Merci d'avance de votre aide

EDIT :

Je vais joindre un fichier exemple pour que l'image soit bien claire