Khalidoune
XLDnaute Nouveau
Bonjour à tous !
Depuis que je vous suis, j'ai pas mal appris donc tout d'abord un grand merci.
Aujourd'hui, je vous sollicite pour finaliser mon programme VBA.
L'idée générale :
- j'ai un répertoire qui comporte un certain nombre de fichier excel
- mon programme vba extrait les données de chacun des fichiers dans ce répertoire et les compile sur mon onglet feuil1
- mon deuxième onglet "Tableau croisé" va analyser les donner de l'onglet feuil1 et permettre de faire des statistiques (nbre de 1/4 d'heure sécurité auquel un collaborateur à assister).
- mon troisième onglet "Liste_personnel" permet de charger la liste du personnel à jour depuis un répertoire
- mon premier onglet "Feuil1" comporte une colonne flash. Lorsque je sélectionne dans cette liste "Saisir le thème", l'information s'enregistre dans la colonne flash saisi.
Mon besoin : pour réaliser ce tableau croisé, il faut que je retraite plusieurs informations par des formules excel :
- dans l'onglet "Feuil1" est-il possible de figer la taille des colonnes après extraction des données issues des fichiers ?
- certains 1/4 d'heure ont une nouvelle appellation. Pour comptabiliser les 1/4 d'heure avec les deux types d'appellation sur la même ligne dans le tableau croisé, il a fallu que je retraite les données téléverser dans l'onglet "Feuil1" vers l'onglet "Paramètre" (tableau bleu).
- dans l'onglet "Tableau Croisé" sur la ligne 1, j'ai besoin que les noms du personnel s'enregistrent automatiquement de la Celulle B1 à ZZZZ1 depuis l'onglet 3 "Liste_personnel' pour être toujours à jour
- dans l'onglet "Tableau Croisé" sur la colonne A, je souhaite que la liste des 1/4 d'heure apparaisse comme suit
- Les 60 premiers flashs sont (normalement) toujours les mêmes et proviennent de l'onglet Paramètre";
- A la suite de ces 60 1er flashs, je souhaite que suivent les flashs Spéciaux (ils sont dans l'onglet Paramètre - Tableau bleu)
- A la suite de ces flashs spéciaux, je souhaite que suivent les flashs Saisis (A extraire depuis la colonne C de l'onglet Feuil1 - il faut donc extraire uniquement les cases remplies en supprimant les doublons et les cases vides sans supprimer les lignes car elles comportent d'autres types d'informations)
Pour l'instant, je fais cela manuellement, mais j'aimerai que le programme réalise la tâche. J'ai essayé mais sans succès. je ne vois pas comment réaliser le bon de code pour réaliser la scrutation puis coller les données, puis enchaîner la deuxième et troisième scrutation pour que ma colonne A soit complète, et sans ligne vide.
Et enfin, mon plus grand challenge : Mon tableau croisé comptabilise le nbre de fois où un collaborateur a assisté à un 1/4 d'heure sécu, qui s'agisse d'un flash classique, spéciaux ou d'un thème saisi. est-il possible de remplir mon tableau pour réaliser ce travail automatiquement sans toutes mes formules ? parce que la je m'aperçois que mon fichier devient très lourd et lent à exploiter. Là honnêtement, j'arrive à des dizaines d'heures (pour ne pas dire plus) consacrées à ce travail. Je ne dirais donc pas NON a un coup de pouce, ou du moins à m'informer si ma demande est réalisable. Cela servira pour mon mémoire de fin d'études, mais si vous me dites que je fais fausse route, je préfère savoir pour ne pas mettre en péril mon diplôme pour de l'acharnement infructueux.
Je joins mon bout de code. impossible de joindre ma pièce jointe car trop volumineux
code - Module 1 :
Option Explicit
' Déclaration des variables
Dim NameSheet As String
Dim L As Integer
Dim DerLigne As Integer
Dim DerLigneTable As Integer
' procédure consolidation classeur
Sub Consolider()
Application.ScreenUpdating = False ' rafraichissement désactiver
'Etape n°1 : Création en-tétes
Columns("A:K").Clear
Range("A1").Value = "Pole"
Range("B1").Value = "Flash"
Range("C1").Value = "Flash Saisi"
Range("D1").Value = "date"
Range("E1").Value = "Nom Animateur"
Range("F1").Value = "Prenom Animateur"
Range("G1").Value = " Fonction "
Range("H1").Value = "collaborateur"
Range("I1").Value = "Coll-Saisi"
Range("J1").Value = "Dossier"
Range("A1 : J1").Interior.Color = vbBlue
Range("A1 : J1").Font.Color = vbWhite
Range("A1 : J1").Font.Bold = True
'Etape n°2 : Parcourir tous les fichiers du dossier
ChDir "C:\Users\k.elhassani\Documents\BYES\KIZEO\Tableau de Suivi\Archivages 2019" ' recherche directory add
NameSheet = Dir("C:\Users\k.elhassani\Documents\BYES\KIZEO\Tableau de Suivi\Archivages 2019\*.xlsx") ' pointeur sur les fichiers xlsx
While Len(NameSheet) > 0
MsgBox NameSheet
Workbooks.Open NameSheet ' ouverture du sheet
L = ActiveSheet.UsedRange.Rows.Count ' lenght first ligne
Range("A2 : J" & L).Copy ' copier les données
Workbooks("Tab de Suivi.xlsm").Activate ' on revient au tab de bord
DerLigne = ActiveSheet.UsedRange.Rows.Count + 1 ' on cherche la ligne 1 vide
Range("A" & DerLigne).Select ' pointeur sur la dernière ligne vide
ActiveSheet.Paste 'on colle les données
Range("J" & DerLigne & ":J" & ActiveSheet.UsedRange.Rows.Count) = NameSheet 'on récupère les noms des classeurs copiés
Workbooks(NameSheet).Close ' fermeture du sheet
NameSheet = Dir ' on passe au sheet suivant
Wend
'Etape n°3 : supp extension
Columns("J:J").Replace ".xlsx", "" 'retirer l'extension des noms des fichiers de la colonne L
Cells.EntireColumn.AutoFit 'ajustement
MsgBox " le fichier est à jour, vous pouvez commencer votre traitement "
Application.ScreenUpdating = True ' rafraichissement désactiver
End Sub
Code - Module 3
Option Explicit
' Déclaration des variables
Dim NameSheet As String
Dim d As Integer
Dim DerLigne As Integer
Dim DerLigneTable As Integer
' procédure consolidation classeur
Sub ListeduPersonnel_2()
Application.ScreenUpdating = False ' rafraichissement désactiver
'Etape n°1 : Création en-tétes
Columns("A:f").Clear
Range("A1").Value = "Agence"
Range("B1").Value = "Pôle"
Range("C1").Value = "Nom, Prénom"
Range("A1 : c1").Interior.Color = vbBlue
Range("A1 : c1").Font.Color = vbWhite
Range("A1 : c1").Font.Bold = True
'Etape n°2 : Parcourir tous les fichiers du dossier
ChDir "C:\Users\k.elhassani\Documents\BYES\KIZEO\Tableau de Suivi\Paramètrage" ' recherche directory add
NameSheet = Dir("C:\Users\k.elhassani\Documents\BYES\KIZEO\Tableau de Suivi\Paramètrage\*.xlsx") ' pointeur sur les fichiers xlsx
While Len(NameSheet) > 0
MsgBox NameSheet
Workbooks.Open NameSheet ' ouverture du sheet
d = ActiveSheet.UsedRange.Rows.Count ' lenght first ligne
Range("A2 : C" & d).Copy ' copier les données
Workbooks("Tab de Suivi.xlsm").Activate ' on revient au tab de bord
DerLigne = ActiveSheet.UsedRange.Rows.Count + 1 ' on cherche la ligne 1 vide
Range("A" & DerLigne).Select ' pointeur sur la dernière ligne vide
ActiveSheet.Paste 'on colle les données
Workbooks(NameSheet).Close ' fermeture du sheet
NameSheet = Dir ' on passe au sheet suivant
Wend
Cells.EntireColumn.AutoFit 'ajustement
MsgBox " le fichier est à jour, vous pouvez commencer votre traitement "
Application.ScreenUpdating = True ' rafraichissement désactiver
End Sub
Merci de m'avoir lu et pour vous retour.
Tonton_K
Depuis que je vous suis, j'ai pas mal appris donc tout d'abord un grand merci.
Aujourd'hui, je vous sollicite pour finaliser mon programme VBA.
L'idée générale :
- j'ai un répertoire qui comporte un certain nombre de fichier excel
- mon programme vba extrait les données de chacun des fichiers dans ce répertoire et les compile sur mon onglet feuil1
- mon deuxième onglet "Tableau croisé" va analyser les donner de l'onglet feuil1 et permettre de faire des statistiques (nbre de 1/4 d'heure sécurité auquel un collaborateur à assister).
- mon troisième onglet "Liste_personnel" permet de charger la liste du personnel à jour depuis un répertoire
- mon premier onglet "Feuil1" comporte une colonne flash. Lorsque je sélectionne dans cette liste "Saisir le thème", l'information s'enregistre dans la colonne flash saisi.
Mon besoin : pour réaliser ce tableau croisé, il faut que je retraite plusieurs informations par des formules excel :
- dans l'onglet "Feuil1" est-il possible de figer la taille des colonnes après extraction des données issues des fichiers ?
- certains 1/4 d'heure ont une nouvelle appellation. Pour comptabiliser les 1/4 d'heure avec les deux types d'appellation sur la même ligne dans le tableau croisé, il a fallu que je retraite les données téléverser dans l'onglet "Feuil1" vers l'onglet "Paramètre" (tableau bleu).
- dans l'onglet "Tableau Croisé" sur la ligne 1, j'ai besoin que les noms du personnel s'enregistrent automatiquement de la Celulle B1 à ZZZZ1 depuis l'onglet 3 "Liste_personnel' pour être toujours à jour
- dans l'onglet "Tableau Croisé" sur la colonne A, je souhaite que la liste des 1/4 d'heure apparaisse comme suit
- Les 60 premiers flashs sont (normalement) toujours les mêmes et proviennent de l'onglet Paramètre";
- A la suite de ces 60 1er flashs, je souhaite que suivent les flashs Spéciaux (ils sont dans l'onglet Paramètre - Tableau bleu)
- A la suite de ces flashs spéciaux, je souhaite que suivent les flashs Saisis (A extraire depuis la colonne C de l'onglet Feuil1 - il faut donc extraire uniquement les cases remplies en supprimant les doublons et les cases vides sans supprimer les lignes car elles comportent d'autres types d'informations)
Pour l'instant, je fais cela manuellement, mais j'aimerai que le programme réalise la tâche. J'ai essayé mais sans succès. je ne vois pas comment réaliser le bon de code pour réaliser la scrutation puis coller les données, puis enchaîner la deuxième et troisième scrutation pour que ma colonne A soit complète, et sans ligne vide.
Et enfin, mon plus grand challenge : Mon tableau croisé comptabilise le nbre de fois où un collaborateur a assisté à un 1/4 d'heure sécu, qui s'agisse d'un flash classique, spéciaux ou d'un thème saisi. est-il possible de remplir mon tableau pour réaliser ce travail automatiquement sans toutes mes formules ? parce que la je m'aperçois que mon fichier devient très lourd et lent à exploiter. Là honnêtement, j'arrive à des dizaines d'heures (pour ne pas dire plus) consacrées à ce travail. Je ne dirais donc pas NON a un coup de pouce, ou du moins à m'informer si ma demande est réalisable. Cela servira pour mon mémoire de fin d'études, mais si vous me dites que je fais fausse route, je préfère savoir pour ne pas mettre en péril mon diplôme pour de l'acharnement infructueux.
Je joins mon bout de code. impossible de joindre ma pièce jointe car trop volumineux
code - Module 1 :
Option Explicit
' Déclaration des variables
Dim NameSheet As String
Dim L As Integer
Dim DerLigne As Integer
Dim DerLigneTable As Integer
' procédure consolidation classeur
Sub Consolider()
Application.ScreenUpdating = False ' rafraichissement désactiver
'Etape n°1 : Création en-tétes
Columns("A:K").Clear
Range("A1").Value = "Pole"
Range("B1").Value = "Flash"
Range("C1").Value = "Flash Saisi"
Range("D1").Value = "date"
Range("E1").Value = "Nom Animateur"
Range("F1").Value = "Prenom Animateur"
Range("G1").Value = " Fonction "
Range("H1").Value = "collaborateur"
Range("I1").Value = "Coll-Saisi"
Range("J1").Value = "Dossier"
Range("A1 : J1").Interior.Color = vbBlue
Range("A1 : J1").Font.Color = vbWhite
Range("A1 : J1").Font.Bold = True
'Etape n°2 : Parcourir tous les fichiers du dossier
ChDir "C:\Users\k.elhassani\Documents\BYES\KIZEO\Tableau de Suivi\Archivages 2019" ' recherche directory add
NameSheet = Dir("C:\Users\k.elhassani\Documents\BYES\KIZEO\Tableau de Suivi\Archivages 2019\*.xlsx") ' pointeur sur les fichiers xlsx
While Len(NameSheet) > 0
MsgBox NameSheet
Workbooks.Open NameSheet ' ouverture du sheet
L = ActiveSheet.UsedRange.Rows.Count ' lenght first ligne
Range("A2 : J" & L).Copy ' copier les données
Workbooks("Tab de Suivi.xlsm").Activate ' on revient au tab de bord
DerLigne = ActiveSheet.UsedRange.Rows.Count + 1 ' on cherche la ligne 1 vide
Range("A" & DerLigne).Select ' pointeur sur la dernière ligne vide
ActiveSheet.Paste 'on colle les données
Range("J" & DerLigne & ":J" & ActiveSheet.UsedRange.Rows.Count) = NameSheet 'on récupère les noms des classeurs copiés
Workbooks(NameSheet).Close ' fermeture du sheet
NameSheet = Dir ' on passe au sheet suivant
Wend
'Etape n°3 : supp extension
Columns("J:J").Replace ".xlsx", "" 'retirer l'extension des noms des fichiers de la colonne L
Cells.EntireColumn.AutoFit 'ajustement
MsgBox " le fichier est à jour, vous pouvez commencer votre traitement "
Application.ScreenUpdating = True ' rafraichissement désactiver
End Sub
Code - Module 3
Option Explicit
' Déclaration des variables
Dim NameSheet As String
Dim d As Integer
Dim DerLigne As Integer
Dim DerLigneTable As Integer
' procédure consolidation classeur
Sub ListeduPersonnel_2()
Application.ScreenUpdating = False ' rafraichissement désactiver
'Etape n°1 : Création en-tétes
Columns("A:f").Clear
Range("A1").Value = "Agence"
Range("B1").Value = "Pôle"
Range("C1").Value = "Nom, Prénom"
Range("A1 : c1").Interior.Color = vbBlue
Range("A1 : c1").Font.Color = vbWhite
Range("A1 : c1").Font.Bold = True
'Etape n°2 : Parcourir tous les fichiers du dossier
ChDir "C:\Users\k.elhassani\Documents\BYES\KIZEO\Tableau de Suivi\Paramètrage" ' recherche directory add
NameSheet = Dir("C:\Users\k.elhassani\Documents\BYES\KIZEO\Tableau de Suivi\Paramètrage\*.xlsx") ' pointeur sur les fichiers xlsx
While Len(NameSheet) > 0
MsgBox NameSheet
Workbooks.Open NameSheet ' ouverture du sheet
d = ActiveSheet.UsedRange.Rows.Count ' lenght first ligne
Range("A2 : C" & d).Copy ' copier les données
Workbooks("Tab de Suivi.xlsm").Activate ' on revient au tab de bord
DerLigne = ActiveSheet.UsedRange.Rows.Count + 1 ' on cherche la ligne 1 vide
Range("A" & DerLigne).Select ' pointeur sur la dernière ligne vide
ActiveSheet.Paste 'on colle les données
Workbooks(NameSheet).Close ' fermeture du sheet
NameSheet = Dir ' on passe au sheet suivant
Wend
Cells.EntireColumn.AutoFit 'ajustement
MsgBox " le fichier est à jour, vous pouvez commencer votre traitement "
Application.ScreenUpdating = True ' rafraichissement désactiver
End Sub
Merci de m'avoir lu et pour vous retour.
Tonton_K
