Création automatique Classeurs ( Sources, feuilles classeurs existants) Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
M
MarieG
Membre habitué
Membre habitué
Messages : 54
Inscrit le : 9 juillet 2019
Version d'Excel : 2013

Message par MarieG » 7 août 2019, 02:43

Bonjour,

Je dispose d'un classeur avec plusieurs feuilles dont des feuilles portant le nom des mois de l'année. Dans ces mois de l'année, j'ai un planning par personnes, je souhaiterais mettre dans un seul fichier excel tout le planning par mois d'une personne.
1-Parmi les feuilles, il y a la liste des personnes. Cela me permet de faire ma boucle et mon filtre (copier que les lignes pour la personne en cours de traitement dans ma boucle) dans la feuille de chaque feuille mois.
2-Puis une personne peut ne pas être planinfiée pour 1 ou pluisiers mois, je fais un test pour compter le nombre d'occurrence.
Puis je crée un classeur dans lequel (la première feuille) je viens de coller la copie faite au point 1
et après ce mois je boucle sur un autre mois, je copie si données et je colle en décalant d'une ligne ainsi de suite.

Le problème c'est que cela ne fonctionne pas comme je veux, j'ai dû recommencer et perdre tout mon code que j'ai pu reconstituer et mais cette fois je n'ai aucun résultat ni aucun bug.

Pouvez-vous svp m'aider à voir plus clair ?

Ci-après le code.
Je mets aussi le fichier de départ
Classeur Global.xlsm
(44.22 Kio) Téléchargé 6 fois
Et le rendu
Exemple du rendu souhaité.xlsx
(19.84 Kio) Téléchargé 10 fois
Merci pour votre aide


Sub Creation_ClasseurCumulMois_Planning_ParPersonne()

Application.ScreenUpdating = False
Application.EnableEvents = False

Dim Fichier As String
Dim Filtre As String
Dim i As Long
Dim j As Long
'Dim Feuille As String
Dim Feuille As Worksheet
Dim Ws As Worksheet



                
'Boucle et compteur sur les collaborateurs existants
For i = ThisWorkbook.Worksheets("F.Collaborateurs").Range("E" & Rows.Count).End(xlUp).Row To 6 Step -1
'le nom du classeur ' nom du collaborateur
Fichier = ThisWorkbook.Worksheets("F.Collaborateurs").Range("E" & i).Value
'la valeur du filtre 'nom du collaborateur
Filtre = ThisWorkbook.Worksheets("F.Collaborateurs").Range("E" & i).Value

       'Ajout d un nouveau classeur
        Set wbk = Workbooks.Add
        'wbk.Activate
        'Première étape Pour détecter les différentes lignes à partir desquelles on colle les planning
        wbk.Sheets(1).Range("D5").Value = "PLANNING " & Fichier



   'Je parcours les feuilles du classeur, je cherche à isoler les feuilles m'intéressent (MOIS)
    For j = ThisWorkbook.Worksheets.Count To 1 Step -1
    'Je voudrais m'arrêter que quand la couleur de l'onglet de la Feuil est de 37( donc les mois) et que c'est rempli _
   '(test sur les 10 premieres lignes
   'If ThisWorkbook.Worksheets(j).Tab.ColorIndex = 37 And _
   'Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets(j).Range("D9:AL10")) > 0 Then
        For Each Feuille In Worksheets
            If Feuille.Tab.ColorIndex = 37 And _
           Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets(j).Range("D9:AL10")) > 0 Then  'Voir si le planning de ce mois est rempli
      
                                       
       'Affectation à la variable WS la feuille du mois
          Set Ws = Feuille
       
                    
                   
            'For NbMois = 1 To Fonction_Nbre_Onglet_Bleu
                   
               'vérifie si le collaborateur est plannifé dans le mois
               '**************
               '***************
               
               'Je regarde si dans la feuille (planning du mois)
                If Application.WorksheetFunction.CountIf(Ws.Range("E:E"), Fichier) > 0 Then
                  Ws.Activate
                  ActiveSheet.Range("$D$8:$AL$2000").AutoFilter Field:=2, Criteria1:=Filtre
                  Range("D7").Select
                  ActiveCell.CurrentRegion.Select
                  Selection.Copy
                                      
                                    
                  'J'active le nouveau classeur crée pour y coller les données du planning
                   wbk.Activate
                   ' Suite Pour détecter les différentes lignes à partir desquelles on colle les planning
                   DernLign1 = Range("D" & Rows.Count).End(xlUp).Row
                   Range("F" & DernLign1 + 1).Value = "Mois " & Ws.Name
                   Range("D" & DernLign1 + 2).Select
                   Selection.PasteSpecial
                                                                                
                   'Dans mon petit encadré qui me sert de trame pour passer les arguments de mes fonctions,
                   'Je postionne mes arguments
                   'ThisWorkbook.Sheets("Sauvegarde_Export").Range("H46").Value = Feuille
                   ThisWorkbook.Sheets("Sauvegarde_Export").Range("H45").Value = Fichier
                                              
                                       
                 
               
               Columns("F:AL").Select
               Selection.ColumnWidth = 5
               
               Columns("A:C").Select
              Selection.ColumnWidth = 0.5
              
               Range("F2:PV4").Select
              With Selection.Font
                  .Name = "Verdana"
                  .Size = 7
              End With
    
            'Next NbMois
                 wbk.SaveAs Filename:=ThisWorkbook.Worksheets("Sauvegarde_Export").Range("B22").Value & _
                "\" & "Planning Global " & "" & Fichier
                
                '  ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Worksheets("Sauvegarde_Export").Range("B22").Value & _
                "\" & "Planning Global " & "" & Fichier & ".xlsx"
                            
                 wbk.Close
    
    
    
                             End If
                    End If
                Next Feuille
          Next j
Next i

             

'Sheets("Sauvegarde_Export").Range("D18").Select

Set wbk = Nothing
Set Ws = Nothing





Application.ScreenUpdating = True
Application.EnableEvents = True

Sheets("Sauvegarde_Export").Activate

End Sub
M
MarieG
Membre habitué
Membre habitué
Messages : 54
Inscrit le : 9 juillet 2019
Version d'Excel : 2013

Message par MarieG » 7 août 2019, 03:19

Cela doit être la fatigue, je fermais ma boucle très tôt.

Ci-après la solution:
Sub Creation_ClasseurCumulMois_Planning_ParPersonne()

Application.ScreenUpdating = False
Application.EnableEvents = False

Dim Fichier As String
Dim Filtre As String
Dim i As Long
Dim j As Long
'Dim Feuille As String
Dim Feuille As Worksheet
Dim Ws As Worksheet



                
'Boucle et compteur sur les collaborateurs existants
For i = ThisWorkbook.Worksheets("F.Collaborateurs").Range("E" & Rows.Count).End(xlUp).Row To 6 Step -1
'le nom du classeur ' nom du collaborateur
Fichier = ThisWorkbook.Worksheets("F.Collaborateurs").Range("E" & i).Value
'la valeur du filtre 'nom du collaborateur
Filtre = ThisWorkbook.Worksheets("F.Collaborateurs").Range("E" & i).Value

       'Ajout d un nouveau classeur
        Set wbk = Workbooks.Add
        wbk.Activate
        'Première étape Pour détecter les différentes lignes à partir desquelles on colle les planning
        wbk.Sheets(1).Range("D5").Value = "PLANNING " & Fichier



   'Je parcours les feuilles du classeur, je cherche à isoler les feuilles m'intéressent (MOIS)
    For j = ThisWorkbook.Worksheets.Count To 1 Step -1
    'Je voudrais m'arrêter que quand la couleur de l'onglet de la Feuil est de 37( donc les mois) et que c'est rempli _
   '(test sur les 10 premieres lignes
   'If ThisWorkbook.Worksheets(j).Tab.ColorIndex = 37 And _
   'Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets(j).Range("D9:AL10")) > 0 Then
        'For Each Feuille In Worksheets
            If ThisWorkbook.Worksheets(j).Tab.ColorIndex = 37 And _
           Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets(j).Range("D9:AL10")) > 0 Then  'Voir si le planning de ce mois est rempli
      
                                       
       'Affectation à la variable WS la feuille du mois
          Set Ws = ThisWorkbook.Worksheets(j)
       
                    
                   
            'For NbMois = 1 To Fonction_Nbre_Onglet_Bleu
                   
               'vérifie si le collaborateur est plannifé dans le mois
               '**************
               '***************
               
               'Je regarde si dans la feuille (planning du mois)
                If Application.WorksheetFunction.CountIf(Ws.Range("E:E"), Fichier) > 0 Then
                  Ws.Activate
                  ActiveSheet.Range("$D$8:$AL$2000").AutoFilter Field:=2, Criteria1:=Filtre
                  Range("D7").Select
                  ActiveCell.CurrentRegion.Select
                  Selection.Copy
                                      
                                    
                  'J'active le nouveau classeur crée pour y coller les données du planning
                   wbk.Activate
                   ' Suite Pour détecter les différentes lignes à partir desquelles on colle les planning
                   DernLign1 = Range("D" & Rows.Count).End(xlUp).Row
                   Range("F" & DernLign1 + 1).Value = "Mois " & Ws.Name
                   Range("D" & DernLign1 + 2).Select
                   Selection.PasteSpecial
                                                                                
                   'Dans mon petit encadré qui me sert de trame pour passer les arguments de mes fonctions,
                   'Je postionne mes arguments
                   'ThisWorkbook.Sheets("Sauvegarde_Export").Range("H46").Value = Feuille
                   ThisWorkbook.Sheets("Sauvegarde_Export").Range("H45").Value = Fichier
                                              
                                       
                 
               
               Columns("F:AL").Select
               Selection.ColumnWidth = 5
               
               Columns("A:C").Select
              Selection.ColumnWidth = 0.5
              
               Range("F2:PV4").Select
              With Selection.Font
                  .Name = "Verdana"
                  .Size = 7
              End With
    
            'Next NbMois
              
    
    
    
                             End If
                    End If
                
              
                
                
                
                
                'Next Feuille
          
                  
          Next j
          
              wbk.SaveAs Filename:=ThisWorkbook.Worksheets("Sauvegarde_Export").Range("B22").Value & _
                "\" & "Planning Global " & "" & Fichier
                
                '  ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Worksheets("Sauvegarde_Export").Range("B22").Value & _
                "\" & "Planning Global " & "" & Fichier & ".xlsx"
                            
                 wbk.Close
                 
          
          
          
          
          
Next i

             

'Sheets("Sauvegarde_Export").Range("D18").Select

Set wbk = Nothing
Set Ws = Nothing





Application.ScreenUpdating = True
Application.EnableEvents = True

'Sheets("Sauvegarde_Export").Activate

End Sub





MarieG a écrit :
7 août 2019, 02:43
Bonjour,

Je dispose d'un classeur avec plusieurs feuilles dont des feuilles portant le nom des mois de l'année. Dans ces mois de l'année, j'ai un planning par personnes, je souhaiterais mettre dans un seul fichier excel tout le planning par mois d'une personne.
1-Parmi les feuilles, il y a la liste des personnes. Cela me permet de faire ma boucle et mon filtre (copier que les lignes pour la personne en cours de traitement dans ma boucle) dans la feuille de chaque feuille mois.
2-Puis une personne peut ne pas être planinfiée pour 1 ou pluisiers mois, je fais un test pour compter le nombre d'occurrence.
Puis je crée un classeur dans lequel (la première feuille) je viens de coller la copie faite au point 1
et après ce mois je boucle sur un autre mois, je copie si données et je colle en décalant d'une ligne ainsi de suite.

Le problème c'est que cela ne fonctionne pas comme je veux, j'ai dû recommencer et perdre tout mon code que j'ai pu reconstituer et mais cette fois je n'ai aucun résultat ni aucun bug.

Pouvez-vous svp m'aider à voir plus clair ?

Ci-après le code.
Je mets aussi le fichier de départ
Classeur Global.xlsm
Et le rendu
Exemple du rendu souhaité.xlsx

Merci pour votre aide


Sub Creation_ClasseurCumulMois_Planning_ParPersonne()

Application.ScreenUpdating = False
Application.EnableEvents = False

Dim Fichier As String
Dim Filtre As String
Dim i As Long
Dim j As Long
'Dim Feuille As String
Dim Feuille As Worksheet
Dim Ws As Worksheet



                
'Boucle et compteur sur les collaborateurs existants
For i = ThisWorkbook.Worksheets("F.Collaborateurs").Range("E" & Rows.Count).End(xlUp).Row To 6 Step -1
'le nom du classeur ' nom du collaborateur
Fichier = ThisWorkbook.Worksheets("F.Collaborateurs").Range("E" & i).Value
'la valeur du filtre 'nom du collaborateur
Filtre = ThisWorkbook.Worksheets("F.Collaborateurs").Range("E" & i).Value

       'Ajout d un nouveau classeur
        Set wbk = Workbooks.Add
        'wbk.Activate
        'Première étape Pour détecter les différentes lignes à partir desquelles on colle les planning
        wbk.Sheets(1).Range("D5").Value = "PLANNING " & Fichier



   'Je parcours les feuilles du classeur, je cherche à isoler les feuilles m'intéressent (MOIS)
    For j = ThisWorkbook.Worksheets.Count To 1 Step -1
    'Je voudrais m'arrêter que quand la couleur de l'onglet de la Feuil est de 37( donc les mois) et que c'est rempli _
   '(test sur les 10 premieres lignes
   'If ThisWorkbook.Worksheets(j).Tab.ColorIndex = 37 And _
   'Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets(j).Range("D9:AL10")) > 0 Then
        For Each Feuille In Worksheets
            If Feuille.Tab.ColorIndex = 37 And _
           Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets(j).Range("D9:AL10")) > 0 Then  'Voir si le planning de ce mois est rempli
      
                                       
       'Affectation à la variable WS la feuille du mois
          Set Ws = Feuille
       
                    
                   
            'For NbMois = 1 To Fonction_Nbre_Onglet_Bleu
                   
               'vérifie si le collaborateur est plannifé dans le mois
               '**************
               '***************
               
               'Je regarde si dans la feuille (planning du mois)
                If Application.WorksheetFunction.CountIf(Ws.Range("E:E"), Fichier) > 0 Then
                  Ws.Activate
                  ActiveSheet.Range("$D$8:$AL$2000").AutoFilter Field:=2, Criteria1:=Filtre
                  Range("D7").Select
                  ActiveCell.CurrentRegion.Select
                  Selection.Copy
                                      
                                    
                  'J'active le nouveau classeur crée pour y coller les données du planning
                   wbk.Activate
                   ' Suite Pour détecter les différentes lignes à partir desquelles on colle les planning
                   DernLign1 = Range("D" & Rows.Count).End(xlUp).Row
                   Range("F" & DernLign1 + 1).Value = "Mois " & Ws.Name
                   Range("D" & DernLign1 + 2).Select
                   Selection.PasteSpecial
                                                                                
                   'Dans mon petit encadré qui me sert de trame pour passer les arguments de mes fonctions,
                   'Je postionne mes arguments
                   'ThisWorkbook.Sheets("Sauvegarde_Export").Range("H46").Value = Feuille
                   ThisWorkbook.Sheets("Sauvegarde_Export").Range("H45").Value = Fichier
                                              
                                       
                 
               
               Columns("F:AL").Select
               Selection.ColumnWidth = 5
               
               Columns("A:C").Select
              Selection.ColumnWidth = 0.5
              
               Range("F2:PV4").Select
              With Selection.Font
                  .Name = "Verdana"
                  .Size = 7
              End With
    
            'Next NbMois
                 wbk.SaveAs Filename:=ThisWorkbook.Worksheets("Sauvegarde_Export").Range("B22").Value & _
                "\" & "Planning Global " & "" & Fichier
                
                '  ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Worksheets("Sauvegarde_Export").Range("B22").Value & _
                "\" & "Planning Global " & "" & Fichier & ".xlsx"
                            
                 wbk.Close
    
    
    
                             End If
                    End If
                Next Feuille
          Next j
Next i

             

'Sheets("Sauvegarde_Export").Range("D18").Select

Set wbk = Nothing
Set Ws = Nothing





Application.ScreenUpdating = True
Application.EnableEvents = True

Sheets("Sauvegarde_Export").Activate

End Sub
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message