Discussion :

[macat]

Bonsoir tout le monde,

Mon souhait pour ce fichier était :

- La création d'une feuille pour chaque stage (manuelle)
- La Feuil1 qui récapitule tous les renseignements de tous les stages (VBA)
- La création d'une feuille par personne, puis pouvoir les supprimer à ma guise (VBA)

Le bouton 1 (Récap formation) et le 2 (Effacer le récap) sont OK. Les macros fonctionnent.
Le bouton 3 (Créer feuille par personne) ne fonctionne plus correctement, me rajoute une feuil2 seulement !!!
Le bouton 4 (Effacer les feuilles nominatives) supprime la feuil1 que je veux conserver(avec toutes les feuilles datées).

Merci à vous de m’aider à écrire ces codes correctement.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Macro1()
'
' Macro1 Macro
'
 
Dim i As Integer
Dim Cel As Range
Dim lig As Integer 'ligne dans feuille recap
Dim ligne As Integer 'ligne dans feuille de recherche
 
lig = 4
 
 
For i = 2 To Sheets.Count
 
    ligne = 11
 
    For Each Cel In Sheets(i).Range("d12:d26")
        ligne = ligne + 1
 
        If IsDate(Cel.Value) Then
 
            lig = lig + 1 'ligne où copier dans recap
            'copie NOM
            Sheets("Feuil1").Range("A" & lig) = Sheets(i).Range("A" & ligne)
            'copie FORMATION
            Sheets("Feuil1").Range("B" & lig) = Sheets(i).Range("B" & ligne)
            'copie DATE DEBUT
            Sheets("Feuil1").Range("C" & lig) = Sheets(i).Range("C" & ligne)
            'copie NOMBRE D'HEURE
            Sheets("Feuil1").Range("D" & lig) = Sheets(i).Range("D" & ligne)
 
        End If
 
    Next Cel
 
Next i
 
End Sub
Sub Effacerlerécapitulatifdesformations()
'
' Effacerlerécapitulatifdesformations Macro
' Macro enregistrée le 21/09/2009
 
'
    Range("A5:D1467").Select
    Selection.ClearContents
    Range("A5").Select
End Sub

et

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Bouton3_QuandClic()
Dim NewSht As Worksheet, Sht As Worksheet, ws As Worksheet
Dim LastLig As Long, NewLig As Long
Dim NewShtName As String
Dim Trouve As Boolean
Dim Cel As Range
 
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 
Set Sht = Sheets("feuil1")
With Sht
    LastLig = .Range("A65536").End(xlUp).Row
 
    For Each Cel In .Range("A3:A" & LastLig)
        Trouve = False
        NewShtName = Cel.Value
        For Each ws In Worksheets
            If ws.Name = NewShtName Then
                Trouve = True
                Exit For
            End If
        Next ws
 
        If Trouve Then
            Set NewSht = ws
        Else
            Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
            NewSht.Name = NewShtName
        End If
 
        NewLig = NewSht.Range("A65536").End(xlUp).Row + 1
        Cel.EntireRow.Copy NewSht.Cells(NewLig, 1)
    Next Cel
End With
 
Set Sht = Nothing
Set NewSht = Nothing
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
End Sub
 
Sub Bouton4_QuandClic()
Dim ws As Worksheet
 
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
 
 
    For Each ws In Worksheets
        If ws.Name <> "Feuil1" Then ws.Delete
    Next ws
 
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

[oOVaveOo]

Bonjour,

Les noms se trouvent bien dans la colonne A ?

Si c'est le cas, mets le fichier en PJ car la macro me paraît bonne à première vue.

tu as essayé en mode débugage ?

@+

[mercatog]

Le nom de ta feuille 1 est bien feuil1 ou Feuil1 ou autre chose?
une simple question

Le bouton 3 (Créer feuille par personne) ne fonctionne plus correctement, me rajoute une feuil2 seulement !!!

C'est à dire fonctionnait (au moins une fois)

[macat]

Bonjour,

Merci de vous intéressez à mon petit souci.

Bon j'ai compressé ce fichier pour que vous puissiez regarder, je ne pouvais pas l'envoyer simplement comme classeur car il vient juste de passer à la taille de 130ko et pas possible de le simplifier plus.

Oui le débogage j'ai vu mais je ne comprends pas pourquoi il n'accepte pas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

NewSht.Name = NewShtName

Bonne journée à vous tous

[mercatog]

Parce que dans A3 tu n'as rien
modifie ici

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
Set Sht = Sheets("feuil1")
With Sht
    LastLig = .Range("A65536").End(xlUp).Row
 
    If LastLig < 5 Then Exit Sub   'AJOUTER CECI POUR EVITER LES ERREURS
 
    For Each Cel In .Range("A5:A" & LastLig)  '<--TES DONNEES A PARTIR DE A5
        Trouve = False
        NewShtName = Cel.Value
        For Each ws In Worksheets
            If ws.Name = NewShtName Then
                Trouve = True
                Exit For
            End If
        Next ws
 
        If Trouve Then
            Set NewSht = ws
        Else
            Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
            NewSht.Name = NewShtName
        End If
....

[macat]

Bon j'ai essayé de faire du nettoyage et corriger ce que tu m'avais proposé.

Mais du coup rien ne ce passe bizarre

Dans le module 2 j'ai enlenvé pour la suppression

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If NewSht.Name <> NewSht.name Then ws.Delete

et ne sais pas par quoi remplacer pour ne garder en faite que la feuille 1 et les feuilles datées.