Discussion :

[Souris1]

Bonjour,

J'ai encore beaucoup de difficultés à m'y retrouver en vba et votre aide serait grandement appréciée. J'ai une liste pour laquelle je désire, à l'aide d'une marcro, créer automatiquement des onglets pour chacune des personnes et compléter le tableau avec les informations correspondantes. À toutes les fois que la liste sera regénérée, celle-ci contiendra à tout coup le même nombre de colonnes mais pas nécessairement le même nombre de lignes

Je ne sais pas si mon explicaton est claire?

Grosso-modo, voici à quoi ressemble ma liste (qui se trouve dans l'onglet «Données»)

Nom No Item Date
Stéphane 123 01/08/2013
Stéphane 456 05/08/2013
Stéphane 667 01/08/2013
Annie 355 09/09/2013
Annie 456 08/09/2013


Je voudrais avoir un onglet pour Stéphane et un onglet pour Annie (et toutes les autres personnes de la liste), puis sur chacun des onglets, je voudrais un tableau avec toutes les informations reliées à la personne.

Lorsqu'il s'agit de boucler en vba (et aures!) c'est un peu (et même beaucoup!) le néant.

Je joins mon fichier excel.

Un gros MERCI!

[danixdb]

Bonjour Souris1, Le Forum

Tu demandes un onglet par prénom de personne, mais ne serait-il pas judicieux d'y adjoindre la société car potentiellement le même prénom peut être identique dans des sociétés différentes.
Autrement rien ne me parait impossible dans ta demande.

Slt

[jordane45]

Bonjour,

Il existe pleins de façons de traiter votre question...

Dans l'immédiat, je vous proposerai bien celle là :

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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
 
Sub triePrenoms()
Dim Nom As String
Dim Ligne As Integer
Dim Sht_Donnees As Worksheet
Set Sht_Donnees = Sheets("Données")
'---------------------------------------
' Definitions des colonnes à récupérer
'----------------------------------------
Dim Col_NoItem As Integer
    Col_NoItem = 4
Dim Col_NoCasType As Integer
    Col_NoCasType = 5
 
'---------------------------------------
' Definitions des colonnes de destination
'----------------------------------------
Dim Col_NoItem_desti As Integer
    Col_NoItem_desti = 4
Dim Col_NoCasType_desti As Integer
    Col_NoCasType_desti = 5
 
' Ligne du début du tableau généré..
Dim Ligne_desti As Integer
 
'----------------------------------------
'Colonne contenant les noms..
'----------------------------------------
Dim PlageNon As Range
Set PlageNon = Range("A2:A50")
 
'----------------------------------------
'Debut du traitement
'----------------------------------------
'Boucle sur cette plage
Sht_Donnees.Activate
For Each cell In PlageNon
  Nom = cell.Value
  NomPrecedent = cell.Offset(-1).Value
  'Changement de nom.. réinitialisation de la variable Ligne_Desti
  If Nom <> NomPrecedent And Nom <> "Nom" And Nom <> "" Then
     Ligne_desti = 7
  End If
     'Si l'onglet n'existe pas ..on prévient l'utilisateur
    If Not FExist(Nom) and Nom<>"" Then
        MsgBox ("La feuille " & Nom & "N'existe pas !")
    Else
      Sht_Donnees.Activate
    'On récupère les données...
       Ligne = cell.Row
       NoItem = Cells(Ligne, Col_NoItem).Value
       NoCasType = Cells(Ligne, Col_NoCasType).Value
       '..etc..
 
    'On met ces valeurs dans la feuille correspondante
    ' On commence à la ligne : 7
    Sheets(Nom).Cells(Ligne_desti, Col_NoItem_desti).Value = NoItem
    Sheets(Nom).Cells(Ligne_desti, Col_NoCasType_desti).Value = NoCasType
    '..etc..
    'On Incrémente la ligne de destination
    Ligne_desti = Ligne_desti + 1
  End If
 
Next
 
End Sub
 
 
Function FExist(NomF As String) As Boolean ' test si la feuille existe
 Application.ScreenUpdating = False
 On Error Resume Next
 FExist = Not Sheets(NomF) Is Nothing
 Application.ScreenUpdating = True
End Function

Bien sur, ce n'est qu'un exemple.
Le code est incomplet.. vous devrez le compléter pour ajouter les différentes colonnes que vous souhaitez récupérer..

[Souris1]

Wow, réponse super rapide!

Merci jordane45. Je vais le tester dès maintenant et je te dirai si ça fonctionne.

Bonne idée danixdb! En ajoutant la société dans le nom de l'onglet, cela m'évitera sans doute bien des soucis

Souris

Bonjour jordane45,

J'ai testé le code que vous m'aviez donné (en complétant avec toutes les colonnes) et j'ai un msg d'erreur

Erreur d'exécution '9'
L'indice n'appartient pas à la sélection

Il bogue à la ligne suivante :

Code :

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

Sheets(Nom).Cells(Ligne_desti, Col_NoItem_desti).Value = NoItem

Voici votre/notre (!) code modifié

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
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
110
111
112
113
114
115
116
117
 
Sub triePrenoms()
Dim Nom As String
Dim Ligne As Integer
Dim Sht_Donnees As Worksheet
Set Sht_Donnees = Sheets("Données")
'---------------------------------------
' Definitions des colonnes à récupérer
'----------------------------------------
 
Dim Col_NoItem As Integer
    Col_NoItem = 4
Dim Col_NoCasType As Integer
    Col_NoCasType = 5
Dim Col_DateMes As Integer
    Col_DateMes = 6
Dim Col_CodeMesure As Integer
    Col_CodeMesure = 7
Dim Col_Poids As Integer
    Col_Poids = 8
Dim Col_ResultatCorrige As Integer
    Col_ResultatCorrige = 9
Dim Col_Resultat As Integer
    Col_Resultat = 10
Dim Col_Minimum As Integer
    Col_Minimum = 11
Dim Col_Maximum As Integer
    Col_Maximum = 12
Dim Col_CodeUnite As Integer
    Col_CodeUnite = 13
 
 
'---------------------------------------
' Definitions des colonnes de destination
'----------------------------------------
Dim Col_NoItem_desti As Integer
    Col_NoItem_desti = 1
Dim Col_NoCasType_desti As Integer
    Col_NoCasType_desti = 2
Dim Col_DateMes_desti As Integer
    Col_DateMes_desti = 3
Dim Col_CodeMesure_desti As Integer
    Col_CodeMesure_desti = 4
Dim Col_Poids_desti As Integer
    Col_Poids_desti = 5
Dim Col_ResultatCorrige_desti As Integer
    Col_ResultatCorrige_desti = 6
Dim Col_Resultat_desti As Integer
    Col_Resultat_desti = 7
Dim Col_Minimum_desti As Integer
    Col_Minimum_desti = 8
Dim Col_Maximum_desti As Integer
    Col_Maximum_desti = 9
Dim Col_CodeUnite_desti As Integer
    Col_CodeUnite_desti = 10
 
 
' Ligne du début du tableau généré..
Dim Ligne_desti As Integer
 
'----------------------------------------
'Colonne contenant les noms..
'----------------------------------------
Dim PlageNon As Range
Set PlageNon = Range("A2:A50")
 
'----------------------------------------
'Debut du traitement
'----------------------------------------
'Boucle sur cette plage
Sht_Donnees.Activate
For Each cell In PlageNon
  Nom = cell.Value
  NomPrecedent = cell.Offset(-1).Value
  'Changement de nom.. réinitialisation de la variable Ligne_Desti
  If Nom <> NomPrecedent And Nom <> "Nom" And Nom <> "" Then
     Ligne_desti = 7
  End If
     'Si l'onglet n'existe pas ..on prévient l'utilisateur
    If Not FExist(Nom) And Nom <> "" Then
        MsgBox ("La feuille " & Nom & "N'existe pas !")
    Else
      Sht_Donnees.Activate
    'On récupère les données...
       Ligne = cell.Row
       NoItem = Cells(Ligne, Col_NoItem).Value
       NoCasType = Cells(Ligne, Col_NoCasType).Value
       DateMes = Cells(Ligne, Col_DateMes).Value
       CodeMesure = Cells(Ligne, Col_CodeMesure).Value
       Poids = Cells(Ligne, Col_Poids).Value
       ResultatCorrige = Cells(Ligne, Col_ResultatCorrige).Value
       Resultat = Cells(Ligne, Col_Resultat).Value
       Minimum = Cells(Ligne, Col_Minimum).Value
       Maximum = Cells(Ligne, Col_Maximum).Value
       CodeUnite = Cells(Ligne, Col_CodeUnite).Value
 
 
    'On met ces valeurs dans la feuille correspondante
    ' On commence à la ligne : 7
    Sheets(Nom).Cells(Ligne_desti, Col_NoItem_desti).Value = NoItem
    Sheets(Nom).Cells(Ligne_desti, Col_NoCasType_desti).Value = NoCasType
    Sheets(Nom).Cells(Ligne_desti, Col_DateMes_desti).Value = Date
    Sheets(Nom).Cells(Ligne_desti, Col_CodeMesure_desti).Value = CodeMesure
    Sheets(Nom).Cells(Ligne_desti, Col_Poids_desti).Value = Poids
    Sheets(Nom).Cells(Ligne_desti, Col_ResultatCorrige_desti).Value = ResultatCorrige
    Sheets(Nom).Cells(Ligne_desti, Col_Resultat_desti).Value = Resultat
    Sheets(Nom).Cells(Ligne_desti, Col_Minimum_desti).Value = Minimum
    Sheets(Nom).Cells(Ligne_desti, Col_Maximum_desti).Value = Maximum
    Sheets(Nom).Cells(Ligne_desti, Col_CodeUnite_desti).Value = CodeUnite
 
    'On Incrémente la ligne de destination
    Ligne_desti = Ligne_desti + 1
  End If
 
Next
 
End Sub

[SfJ5Rpw8]

bonsoir,

lorsque la fenêtre de debug apparait , actionne le bouton debug .. puis passe la souris sur tes variables Nom,Ligne_desti , Col_NoItem_desti , afin de voir leur valeur dans l'info-bulle qui apparait et contrôle ou reporte nous ces valeurs...

[Souris1]

Bonjour,

J'ai tenté de faire un essai avec un petit bout de code que j'ai récupéré je ne sais trop où, ça fonctionne... mais à moitié!

Ce qui fonctionne :

-Je réussi à créer autant d'onglet (basé sur l'onglet «Modèle») qu'il y a différentes personnes dans ma colonne A

-Il copie la première ligne de donnée reliée à cette personne dans le tableau

Ce qui ne fonctionne pas

-Je n'ai pas réussi à faire la boucle qui permet de copier toutes les lignes reliées à la personne.

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
Sub CreationOnglet()
Dim O As Long
Dim Ws As Worksheet
 
  Application.ScreenUpdating = False
  Set Ws = Sheets("Données")
  For O = 2 To Range("A" & Rows.Count).End(xlUp).Row
    If Not ExisteFeuille(Ws.Range("A" & O).Text) Then
      Sheets.Add after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Ws.Range("A" & O)
      Sheets("Modèle").Cells.Copy Destination:=Range("A1")
      Range("A5") = Ws.Range("A" & O)
      Range("A2") = Ws.Range("B" & O)
      Range("A3") = Ws.Range("C" & O)
      Range("A7") = Ws.Range("D" & O)
      Range("B7") = Ws.Range("E" & O)
      Range("C7") = Ws.Range("F" & O)
      Range("D7") = Ws.Range("G" & O)
      Range("E7") = Ws.Range("H" & O)
      Range("F7") = Ws.Range("I" & O)
      Range("G7") = Ws.Range("J" & O)
      Range("H7") = Ws.Range("K" & O)
      Range("I7") = Ws.Range("L" & O)
      Range("J7") = Ws.Range("M" & O)
 
    End If
  Next O
  Ws.Select
End Sub