Regrouper des onglets selon leur nom [VBA]

[nat54]

Bonjour,

Je vais essayer de faire clair mais cela n'est pas simple

--> un répertoire où j'exporte des fichiers excel en provenance de BO
....\Exports_BO_provisoires

10 fichiers tous présentés de la même manière à savoir 31 onglets, un onglet par code pôle

L'objectif est de créer 31 fichiers (un par pôle) avec 10 onglets
les onglets sont "reconnaissables" car ils contiennent le code pole

je l'avais fait pour 4 avec votre aide (mais je ne trouve plus le fil), je voulais le faire pour 10 fichiers
a priori c'était facile mais je bloque


Le code actuel
Le pb est en rouge, excel me dit
"variable objet ou variable de bloc With non définie"

Sub Creer_un_fichier_par_pole()
Dim Fn_BAR_incoherente_vs_BAT As String, Fn_Badg_fac_decp_horaire As String, Fn_BAR_inf_BAT As String, Fn_CA_negatif As String, Fn_Agent_jour_BAT_diff_7 As String, Fn_Agent_nuit_BAT_diff_6h30 As String, Fn_Param_BAR As String, Fn_RC_inf_35 As String, Fn_RC_sup_100 As String, Fn_RTT_negatif As String, wbk_BAR_incoherente_vs_BAT As Workbook, wbk_Badg_fac_decp_horaire As Workbook, wbk_BAR_inf_BAT As Workbook, wbk_CA_negatif As Workbook, wbk_Agent_jour_BAT_diff_7 As Workbook, wbk_Agent_nuit_BAT_diff_6h30 As Workbook, wbk_Param_BAR As Workbook, wbk_RC_inf_35 As Workbook, wbk_RC_sup_100 As Workbook, wbk_RTT_negatif As Workbook, newWbk As Workbook, extractFolderPath As String, sht_BAR_incoherente_vs_BAT As Worksheet, sht_Badg_fac_decp_horaire As Worksheet, sht_BAR_inf_BAT As Worksheet, sht_CA_negatif As Worksheet, sht_Agent_jour_BAT_diff_7 As Worksheet, sht_Agent_nuit_BAT_diff_6h30 As Worksheet, sht_Param_BAR As Worksheet, sht_RC_inf_35 As Worksheet, sht_RC_sup_100 As Worksheet, sht_RTT_negatif As Worksheet, Code
Application.DisplayAlerts = False
'récupérer les "fichier sources" et le "dossier destination"
Fn_BAR_incoherente_vs_BAT = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_BAR_incoherente_vs_BAT""")
Fn_Badg_fac_decp_horaire = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_badg_fac_pr_decpte_horaire""")
Fn_BAR_inf_BAT = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_BAR_inf_BAT""")
Fn_CA_negatif = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_CA_negatif""")
Fn_Agent_jour_BAT_diff_7 = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_jour_BATp_diff_7_par_pole""")
Fn_Agent_nuit_BAT_diff_6h30 = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_nuit_BATp_diff_6h30""")
Fn_Param_BAR = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_PARAM-BAR""")
Fn_RC_inf_35 = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_RC_inf_35""")
Fn_RC_sup_100 = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_RC_sup_100""")
Fn_RTT_negatif = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_RTT_negatif""")
extractFolderPath = "I:\DRH\EFFECTIF\BO\Gestor\Fichiers_par_pole"

'ouvrir les "fichier sources"
Set wbk_BAR_incoherente_vs_BAT = Application.Workbooks.Open(Filename:=Fn_BAR_incoherente_vs_BAT, ReadOnly:=True)
Set wbk_Badg_fac_decp_horaire = Application.Workbooks.Open(Filename:=Fn_Badg_fac_decp_horaire, ReadOnly:=True)
Set wbk_BAR_inf_BAT = Application.Workbooks.Open(Filename:=Fn_BAR_inf_BAT, ReadOnly:=True)
Set wbk_CA_negatif = Application.Workbooks.Open(Filename:=Fn_CA_negatif, ReadOnly:=True)
Set wbk_Agent_jour_BAT_diff_7 = Application.Workbooks.Open(Filename:=Fn_Agent_jour_BAT_diff_7, ReadOnly:=True)
Set wbk_Agent_nuit_BAT_diff_6h30 = Application.Workbooks.Open(Filename:=Fn_Agent_nuit_BAT_diff_6h30, ReadOnly:=True)
Set wbk_Param_BAR = Application.Workbooks.Open(Filename:=Fn_Param_BAR, ReadOnly:=True)
Set wbk_RC_inf_35 = Application.Workbooks.Open(Filename:=Fn_RC_inf_35, ReadOnly:=True)
Set wbk_RC_sup_100 = Application.Workbooks.Open(Filename:=Fn_RC_sup_100, ReadOnly:=True)
Set wbk_RTT_negatif = Application.Workbooks.Open(Filename:=Fn_RTT_negatif, ReadOnly:=True)
 
    'boucler sur les onglets du fichier BAR_incoherente_BAT
    For Each sht_BAR_incoherente_vs_BAT In wbk_BAR_incoherente_vs_BAT.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_BAR_incoherente_vs_BAT.Name, CodePole) > 0 [COLOR=red]Then sht_BAR_incoherente_vs_BAT.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)[/COLOR]
    Next sht_BAR_incoherente_vs_BAT
        'boucler sur les onglets du fichier wbk_Badg_fac_decp_horaire
    For Each sht_Badg_fac_decp_horaire In wbk_Badg_fac_decp_horaire.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_Badg_fac_decp_horaire.Name, CodePole) > 0 Then sht_Badg_fac_decp_horaire.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_Badg_fac_decp_horaire
    'boucler sur les onglets du fichier wbk_BAR_inf_BAT
    For Each sht_BAR_inf_BAT In wbk_BAR_inf_BAT.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_BAR_inf_BAT.Name, CodePole) > 0 Then sht_BAR_inf_BAT.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
            Next sht_BAR_inf_BAT
    'boucler sur les onglets du fichier wbk_CA_negatif
    For Each sht_CA_negatif In wbk_CA_negatif.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_CA_negatif.Name, CodePole) > 0 Then sht_CA_negatif.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_CA_negatif
    'boucler sur les onglets du fichier wbk_Agent_jour_BAT_diff_7
    For Each sht_Agent_jour_BAT_diff_7 In wbk_Agent_jour_BAT_diff_7.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_Agent_jour_BAT_diff_7.Name, CodePole) > 0 Then sht_Agent_jour_BAT_diff_7.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_Agent_jour_BAT_diff_7
    'boucler sur les onglets du fichier wbk_Agent_nuit_BAT_diff_6h30
    For Each sht_Agent_nuit_BAT_diff_6h30 In wbk_Agent_nuit_BAT_diff_6h30.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_Agent_nuit_BAT_diff_6h30.Name, CodePole) > 0 Then sht_Agent_nuit_BAT_diff_6h30.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_Agent_nuit_BAT_diff_6h30
    'boucler sur les onglets du fichier wbk_Param_BAR
    For Each sht_Param_BAR In wbk_Param_BAR.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_Param_BAR.Name, CodePole) > 0 Then sht_Param_BAR.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_Param_BAR
    'boucler sur les onglets du fichier wbk_RC_inf_35
    For Each sht_RC_inf_35 In wbk_RC_inf_35.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(wbk_RC_inf_35.Name, CodePole) > 0 Then wbk_RC_inf_35.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_RC_inf_35
    'boucler sur les onglets du fichier wbk_RC_sup_100
    For Each sht_RC_sup_100 In wbk_RC_sup_100.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_RC_sup_100.Name, CodePole) > 0 Then sht_RC_sup_100.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_RC_sup_100
    'boucler sur les onglets du fichier wbk_RTT_negatif
    For Each sht_RTT_negatif In wbk_RTT_negatif.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_RTT_negatif.Name, CodePole) > 0 Then sht_RTT_negatif.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_RTT_negatif
    
 
    'sauvegarder et fermer le classeur spécifique à ce pole
    newWbk.SaveAs extractFolderPath & "\ANOMALIES_" & CodePole
    newWbk.Close
 
'fermer les classeurs
wbk_BAR_incoherente_vs_BAT.Close: Set wbk_BAR_incoherente_vs_BAT = Nothing
wbk_Badg_fac_decp_horaire.Close: Set wbk_Badg_fac_decp_horaire = Nothing
wbk_BAR_inf_BAT.Close: Set wbk_BAR_inf_BAT = Nothing
wbk_CA_negatif.Close: Set wbk_CA_negatif = Nothing
wbk_Agent_jour_BAT_diff_7.Close: Set wbk_Agent_jour_BAT = Nothing
wbk_Agent_nuit_BAT_diff_6h30.Close: Set wbk_Agent_nuit_BAT_diff_6h30 = Nothing
wbk_Param_BAR.Close: Set wbk_Param_BAR = Nothing
wbk_RC_inf_35.Close: Set wbk_RC_inf_35 = Nothing
wbk_RC_sup_100: Set wbk_RC_sup_100 = Nothing
wbk_RTT_negatif.Close: Set wbk_RTT_negatif = Nothing
Set newWbk = Nothing
Application.DisplayAlerts = True
End Sub

merci d'avance

 

[Pierrot93]

Re : Regrouper des onglets selon leur nom [VBA]

Bonjour Nat

A priori tu cherches à copier tes feuilles dans un nouveau classseur "newWbk", mais sauf erreur de ma part je ne vois pas cette variable initialisée.... Manque peut être un :

Set newWbk = Workbooks.Add

bonne journée
@+

 

[nat54]

Re : Regrouper des onglets selon leur nom [VBA]

et je devrais mettre ça où ? avant toutes les boucles ?

edit : je vais tester un truc car j'avais un peu modifié un des fichiers qui ne contenait pas de code pole et j'ai zappé une partie de code qui devait être utile

'boucler sur les onglets du fichier RC
For Each shtRCinf35 In wbkRCinf35.Sheets
    
    'récupérer le code pole de l'"onglet RC" analysé
    CodePole = Replace(shtRCinf35.Name, "PB RC", "")
    
    'créer le classeur spécifique à ce pole
    Set newWbk = Application.Workbooks.Add
    
    'copier l'"onglet RC" analysé après le dernier onglet du nouveau classeur
    shtRCinf35.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    
    'supprimer toutes les autres feuilles
    While newWbk.Sheets.Count > 1
        newWbk.Sheets(1).Delete
    Wend
    newWbk.Sheets(newWbk.Sheets.Count).Name = newWbk.Sheets(newWbk.Sheets.Count).Name & "inf35"

 

[Pierrot93]

Re : Regrouper des onglets selon leur nom [VBA]

Re

oui, avant de l'utiliser bien sur....

 

[nat54]

Re : Regrouper des onglets selon leur nom [VBA]

le nouveau code

Sub Creer_un_fichier_par_pole()
Dim Fn_BAR_incoherente_vs_BAT As String, Fn_Badg_fac_decp_horaire As String, Fn_BAR_inf_BAT As String, Fn_CA_negatif As String, Fn_Agent_jour_BAT_diff_7 As String, Fn_Agent_nuit_BAT_diff_6h30 As String, Fn_Param_BAR As String, Fn_RC_inf_35 As String, Fn_RC_sup_100 As String, Fn_RTT_negatif As String, wbk_BAR_incoherente_vs_BAT As Workbook, wbk_Badg_fac_decp_horaire As Workbook, wbk_BAR_inf_BAT As Workbook, wbk_CA_negatif As Workbook, wbk_Agent_jour_BAT_diff_7 As Workbook, wbk_Agent_nuit_BAT_diff_6h30 As Workbook, wbk_Param_BAR As Workbook, wbk_RC_inf_35 As Workbook, wbk_RC_sup_100 As Workbook, wbk_RTT_negatif As Workbook, newWbk As Workbook, extractFolderPath As String, sht_BAR_incoherente_vs_BAT As Worksheet, sht_Badg_fac_decp_horaire As Worksheet, sht_BAR_inf_BAT As Worksheet, sht_CA_negatif As Worksheet, sht_Agent_jour_BAT_diff_7 As Worksheet, sht_Agent_nuit_BAT_diff_6h30 As Worksheet, sht_Param_BAR As Worksheet, sht_RC_inf_35 As Worksheet, sht_RC_sup_100 As Worksheet, sht_RTT_negatif As Worksheet, Code
Application.DisplayAlerts = False
'récupérer les "fichier sources" et le "dossier destination"
Fn_BAR_incoherente_vs_BAT = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_BAR_incoherente_vs_BAT""")
Fn_Badg_fac_decp_horaire = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_badg_fac_pr_decpte_horaire""")
Fn_BAR_inf_BAT = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_BAR_inf_BAT""")
Fn_CA_negatif = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_CA_negatif""")
Fn_Agent_jour_BAT_diff_7 = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_jour_BATp_diff_7_par_pole""")
Fn_Agent_nuit_BAT_diff_6h30 = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_nuit_BATp_diff_6h30""")
Fn_Param_BAR = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_PARAM-BAR""")
Fn_RC_inf_35 = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_RC_inf_35""")
Fn_RC_sup_100 = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_RC_sup_100""")
Fn_RTT_negatif = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx; *.xlsm", Title:="Sélectionnez le fichier "" POLE_pb_RTT_negatif""")
extractFolderPath = "I:\DRH\EFFECTIF\BO\Gestor\Fichiers_par_pole"
 
'ouvrir les "fichier sources"
Set wbk_BAR_incoherente_vs_BAT = Application.Workbooks.Open(Filename:=Fn_BAR_incoherente_vs_BAT, ReadOnly:=True)
Set wbk_Badg_fac_decp_horaire = Application.Workbooks.Open(Filename:=Fn_Badg_fac_decp_horaire, ReadOnly:=True)
Set wbk_BAR_inf_BAT = Application.Workbooks.Open(Filename:=Fn_BAR_inf_BAT, ReadOnly:=True)
Set wbk_CA_negatif = Application.Workbooks.Open(Filename:=Fn_CA_negatif, ReadOnly:=True)
Set wbk_Agent_jour_BAT_diff_7 = Application.Workbooks.Open(Filename:=Fn_Agent_jour_BAT_diff_7, ReadOnly:=True)
Set wbk_Agent_nuit_BAT_diff_6h30 = Application.Workbooks.Open(Filename:=Fn_Agent_nuit_BAT_diff_6h30, ReadOnly:=True)
Set wbk_Param_BAR = Application.Workbooks.Open(Filename:=Fn_Param_BAR, ReadOnly:=True)
Set wbk_RC_inf_35 = Application.Workbooks.Open(Filename:=Fn_RC_inf_35, ReadOnly:=True)
Set wbk_RC_sup_100 = Application.Workbooks.Open(Filename:=Fn_RC_sup_100, ReadOnly:=True)
Set wbk_RTT_negatif = Application.Workbooks.Open(Filename:=Fn_RTT_negatif, ReadOnly:=True)
 
'boucler sur les onglets du fichier RC inf 35
For Each sht_RC_inf_35 In wbk_RC_inf_35.Sheets
 
    'récupérer le code pole de l'"onglet RC" analysé
    CodePole = Replace(sht_RC_inf_35.Name, "PB RC", "")
 
    'créer le classeur spécifique à ce pole
    Set newWbk = Application.Workbooks.Add
 
    'copier l'onglet RC analysé après le dernier onglet du nouveau classeur
    sht_RC_inf_35.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
 
    'supprimer toutes les autres feuilles
    While newWbk.Sheets.Count > 1
        newWbk.Sheets(1).Delete
    Wend
    newWbk.Sheets(newWbk.Sheets.Count).Name = newWbk.Sheets(newWbk.Sheets.Count).Name & "inf35"
 
 
    'boucler sur les onglets du fichier BAR_incoherente_BAT
 
    For Each sht_BAR_incoherente_vs_BAT In wbk_BAR_incoherente_vs_BAT.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_BAR_incoherente_vs_BAT.Name, CodePole) > 0 Then sht_BAR_incoherente_vs_BAT.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_BAR_incoherente_vs_BAT
        'boucler sur les onglets du fichier wbk_Badg_fac_decp_horaire
    For Each sht_Badg_fac_decp_horaire In wbk_Badg_fac_decp_horaire.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_Badg_fac_decp_horaire.Name, CodePole) > 0 Then sht_Badg_fac_decp_horaire.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_Badg_fac_decp_horaire
    'boucler sur les onglets du fichier wbk_BAR_inf_BAT
    For Each sht_BAR_inf_BAT In wbk_BAR_inf_BAT.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_BAR_inf_BAT.Name, CodePole) > 0 Then sht_BAR_inf_BAT.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
            Next sht_BAR_inf_BAT
    'boucler sur les onglets du fichier wbk_CA_negatif
    For Each sht_CA_negatif In wbk_CA_negatif.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_CA_negatif.Name, CodePole) > 0 Then sht_CA_negatif.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_CA_negatif
    'boucler sur les onglets du fichier wbk_Agent_jour_BAT_diff_7
    For Each sht_Agent_jour_BAT_diff_7 In wbk_Agent_jour_BAT_diff_7.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_Agent_jour_BAT_diff_7.Name, CodePole) > 0 Then sht_Agent_jour_BAT_diff_7.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_Agent_jour_BAT_diff_7
    'boucler sur les onglets du fichier wbk_Agent_nuit_BAT_diff_6h30
    For Each sht_Agent_nuit_BAT_diff_6h30 In wbk_Agent_nuit_BAT_diff_6h30.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_Agent_nuit_BAT_diff_6h30.Name, CodePole) > 0 Then sht_Agent_nuit_BAT_diff_6h30.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_Agent_nuit_BAT_diff_6h30
    'boucler sur les onglets du fichier wbk_Param_BAR
    For Each sht_Param_BAR In wbk_Param_BAR.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_Param_BAR.Name, CodePole) > 0 Then sht_Param_BAR.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_Param_BAR
 
    'boucler sur les onglets du fichier wbk_RC_sup_100
    For Each sht_RC_sup_100 In wbk_RC_sup_100.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_RC_sup_100.Name, CodePole) > 0 Then sht_RC_sup_100.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_RC_sup_100
    'boucler sur les onglets du fichier wbk_RTT_negatif
    For Each sht_RTT_negatif In wbk_RTT_negatif.Sheets
        'si le nom de l'onglet analysé contient le "code pole", alors on copie la feuille dans le nouveau classeur
        If InStr(sht_RTT_negatif.Name, CodePole) > 0 Then sht_RTT_negatif.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)
    Next sht_RTT_negatif
 
 
    'sauvegarder et fermer le classeur spécifique à ce pole
    newWbk.SaveAs extractFolderPath & "\ANOMALIES_" & CodePole
    newWbk.Close
 
Next sht_RC_inf_35
'fermer les classeurs
wbk_BAR_incoherente_vs_BAT.Close: Set wbk_BAR_incoherente_vs_BAT = Nothing
wbk_Badg_fac_decp_horaire.Close: Set wbk_Badg_fac_decp_horaire = Nothing
wbk_BAR_inf_BAT.Close: Set wbk_BAR_inf_BAT = Nothing
wbk_CA_negatif.Close: Set wbk_CA_negatif = Nothing
wbk_Agent_jour_BAT_diff_7.Close: Set wbk_Agent_jour_BAT = Nothing
wbk_Agent_nuit_BAT_diff_6h30.Close: Set wbk_Agent_nuit_BAT_diff_6h30 = Nothing
wbk_Param_BAR.Close: Set wbk_Param_BAR = Nothing
wbk_RC_inf_35.Close: Set wbk_RC_inf_35 = Nothing
wbk_RC_sup_100: Set wbk_RC_sup_100 = Nothing
wbk_RTT_negatif.Close: Set wbk_RTT_negatif = Nothing
Set newWbk = Nothing
Application.DisplayAlerts = True
End Sub

je ne comprends pas trop dans quel ordre excel travaille ...

ca marche du code 3580 à 4170 siot 25 fichiers sur 31

il met bien à l'intérieur
* rc_inf_35 : 1er dans la liste
* param_BAR : 7è dans la liste
* BAR_incoherente_vs_BAT : il s'arrête au 25è et plante excel

 

[Pierrot93]

Re : Regrouper des onglets selon leur nom [VBA]

Re,

attention tu initialises ta variable dans la boucle "for each", dans ce cas un nouveau classeur est créé pour chaque feuille de ton fichier "RC inf 35
", c'est bien ce que tu veux ?

 

[nat54]

Re : Regrouper des onglets selon leur nom [VBA]

oui sur la base du fichier RC inf 35 où j'ai 31 onglets nommés
PB RC 3580
PB RC 3945
..

je crée 31 fichiers nommés
ANOMALIES_3580
ANOMALIES_3945




et dans chacun de ces fichiers anomalies, le vba doit regrouper 10 onglets qui sont chacun nommés

1. PB RC 3580
2. BAR=99 3580
3. RC_sup_100_3580
4. RTT_neg_3580
5. BAR _ 3580
6. agt_nuit_BATp_diff_6.5_3580
7. agt_jour_BATp_diff_7_3580
8. BAR_inf_BAT_3580
9. 3580_dec_hor
10. CA_neg_3580

==> le point commun = le code pole

il te faut les 10 fichiers "anonymes" ? ca prendrait un peu de temps mais s'il le faut ...

 

[nat54]

Re : Regrouper des onglets selon leur nom [VBA]

finalement j'ai anonymé rapidement en effacant toutes les données car ce n'est pas important, c'est la structure des fichiers qui l'est

--> les 10 fichiers d'export
--> le fichier d'où je lance ma macro

 

[Pierrot93]

Re : Regrouper des onglets selon leur nom [VBA]

Re

commence peut être pas mettre "Option Explicit" en tête de module, ce qui oblige la déclaration des variables et de ce fait vba vérifiera au préalable leur existance, il en ressort déjà un problème au moins sur 2... remets le classeur contenant la macro en pièce jointe, une fois corrigé si ton problème demeure...

@+

 

[Pierrot93]

Re : Regrouper des onglets selon leur nom [VBA]

Re

le fil précédent auquel tu faisais allusion :

https://www.excel-downloads.com/thr...-des-caracteres-communs-en-un-fichier.119348/

 

[nat54]

Re : Regrouper des onglets selon leur nom [VBA]

Tu vas me prendre pour une nulle

Effectivement CodePole n'est pas déclaré
Code apparait dans la déclaration mais Pole As String

je veux le rajouter mais ca bloque

 

[Pierrot93]

Re : Regrouper des onglets selon leur nom [VBA]

Re

oui, mais tu a tout déclaré sur la même ligne, il doit y avoir une limite du nombre de caractères par ligne, préférable utiliser plusieurs lignes, en plus cela facilite la lecture.... et il existe d'autres variables pas ou mal déclarées...

Option Explicit
Sub Creer_un_fichier_par_pole()
Dim Fn_BAR_incoherente_vs_BAT As String, Fn_Badg_fac_decp_horaire As String, Fn_BAR_inf_BAT As String, Fn_CA_negatif As String, Fn_Agent_jour_BAT_diff_7 As String, Fn_Agent_nuit_BAT_diff_6h30 As String, Fn_Param_BAR As String
Dim Fn_RC_inf_35 As String, Fn_RC_sup_100 As String, Fn_RTT_negatif As String, wbk_BAR_incoherente_vs_BAT As Workbook, wbk_Badg_fac_decp_horaire As Workbook, wbk_BAR_inf_BAT As Workbook, wbk_CA_negatif As Workbook, wbk_Agent_jour_BAT_diff_7 As Workbook
Dim wbk_Agent_nuit_BAT_diff_6h30 As Workbook, wbk_Param_BAR As Workbook, wbk_RC_inf_35 As Workbook, wbk_RC_sup_100 As Workbook, wbk_RTT_negatif As Workbook, newWbk As Workbook, extractFolderPath As String, sht_BAR_incoherente_vs_BAT As Worksheet
Dim sht_Badg_fac_decp_horaire As Worksheet, sht_BAR_inf_BAT As Worksheet, sht_CA_negatif As Worksheet, sht_Agent_jour_BAT_diff_7 As Worksheet, sht_Agent_nuit_BAT_diff_6h30 As Worksheet, sht_Param_BAR As Worksheet, sht_RC_inf_35 As Worksheet
Dim sht_RC_sup_100 As Worksheet, sht_RTT_negatif As Worksheet, CodePole As String

 

[nat54]

Re : Regrouper des onglets selon leur nom [VBA]

quand j'allais à la ligne via "enter" ca me mettait le code en rouge " : attendu"

edit : car je ne remettais pas dim en début de ligne ...

 

[nat54]

Re : Regrouper des onglets selon leur nom [VBA]

par contre ca bloque toujours au même endroit après le code 4170 avec toujours que 3 onglets ..

 

[Pierrot93]

Re : Regrouper des onglets selon leur nom [VBA]

Re,

faire "enter" avant la virgule, et faire précéder la nouvelle ligne par "dim"... As tu été voir ton fil précédent que j'avais retrouvé, la solution est peut être déjà dedans... sinon exécuté ton code pas à pas et vérifier si les onglets existent ou pas... en respectant l'orthographe et la casse.... des classeurs / onglets et des variables recherchés... vu le nombre de vérif, perso je n'aurais pas trop le temps.... désolé...