Regrouper des onglets selon leur nom [VBA]

nat54

XLDnaute Barbatruc
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"

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 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
 

nat54

XLDnaute Barbatruc
Re : Regrouper des onglets selon leur nom [VBA]

là je ne comprends pas j'ai fait le pas à pas de A à Z avec la touche F8
(maintenue par mon agrafeuse car ca dure longtemps :D)

et j'obtiens bien mes 31 fichiers (certes avec que 3 onglets sur 10, mais j'ai vu que ca vient du 'count', je verrais dans un 2nd temps)

je relance en automatique et paf ca s'arrête après le 25è fichier

quelqu'un pour m'aider ?
 

Pierrot93

XLDnaute Barbatruc
Re : Regrouper des onglets selon leur nom [VBA]

Re,

essaye en modifiant l'initialisation de "CodePole " ainsi :

Code:
CodePole = "*" & Trim(Replace(sht_RC_inf_35.Name, "PB RC", "")) & "*"

et dans les différentes boucles ceci :

Code:
    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
      [B]  If sht_BAR_incoherente_vs_BAT.Name Like [/B]CodePole Then sht_BAR_incoherente_vs_BAT.Copy after:=newWbk.Sheets(newWbk.Sheets.Count): Exit For
    Next sht_BAR_incoherente_vs_BAT

@+
 

Pierrot93

XLDnaute Barbatruc
Re : Regrouper des onglets selon leur nom [VBA]

Re

du coup, il faut également modifier cette ligne :

Code:
    newWbk.SaveAs extractFolderPath & "\ANOMALIES_" & Replace(CodePole, "*", "")

A priori, la copy accroche sur ce fichier "wbk_Agent_nuit_BAT_diff_6h30.Sheets" en automatique... mais une fois arreté par le "debogage" passe via la touche F8... Peut être dû aux noms à rallonge des onglets et en plus ceux-ci comportent un point.... "agt_nuit_BATp_diff_6.5_4230"

@+
 

Pierrot93

XLDnaute Barbatruc
Re : Regrouper des onglets selon leur nom [VBA]

Re

bon, avec ou sans point dans le nom de l'onglet c'est toujours le même fichier qui accroche, par contre après la fenêtre de débogage, la macro peut repartir en auto après click sur l'icone "Exécuter sub"...
 

pierrejean

XLDnaute Barbatruc
Re : Regrouper des onglets selon leur nom [VBA]

bonsoir a tous

Salut Pierrot

j'ai jeté un coup d'oeil , suivi les indications de mon ami Pierrot , modifié extract..... pour envoyer sur mon DD
Resultat: 25 fichiers créés puis plante de windows
Le rapport d'erreur me suggere de faire un Update d'Office
Apres Update (curieusement d'Office 2007 alors que je suis sous 2000) nouvel essai et replante de Windows (plus severe puisque j'ai du repartir du CD d'installation)
Je persevere mais en serrant les fesses
Si vous n'avez pas de suivi dans les 24 c'est que ce sera grave !!!

A titre indicatif c'est sur la feuille 4170 que je retrouve le fichier RC_inf
 
Dernière édition:

Pierrot93

XLDnaute Barbatruc
Re : Regrouper des onglets selon leur nom [VBA]

Re,

Bonsoir PierreJean:)

Aarf, PierreJean, pas de plantage windows chez moi, simplement une erreur d'exécution 1004 "la methode copy de l'objet worksheet a échoué", avec ouverture de la fenêtre de débogage habituelle....

te souhaitant un bon courage et une bonne soirée, ainsi que de bonnes fêtes de fin d'année.
 
Dernière édition:

nat54

XLDnaute Barbatruc
Re : Regrouper des onglets selon leur nom [VBA]

Alors après test du nouveau code, ca a bien fait les 31 fichiers mais uniquement avec un onglet dans chaque fichier crée
PB RC ****inf35
où **** correspond au code pole associé

j'ai peut-être raté une étape :confused:
 

Pièces jointes

  • procedure.xls
    40.5 KB · Affichages: 47
  • procedure.xls
    40.5 KB · Affichages: 49
  • procedure.xls
    40.5 KB · Affichages: 48

Pierrot93

XLDnaute Barbatruc
Re : Regrouper des onglets selon leur nom [VBA]

Re,

ci-dessous code utilisé à l'instant, c'est déroulé complètement et sans plantage, création de 31 fichiers de 10 onglets....

Code:
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, 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
Dim CodePole As String
Application.DisplayAlerts = False
Application.ScreenUpdating = 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 = "*" & Trim(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 sht_BAR_incoherente_vs_BAT.Name Like CodePole Then sht_BAR_incoherente_vs_BAT.Copy after:=newWbk.Sheets(newWbk.Sheets.Count): Exit For
    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 sht_Badg_fac_decp_horaire.Name Like CodePole Then sht_Badg_fac_decp_horaire.Copy after:=newWbk.Sheets(newWbk.Sheets.Count): Exit For
    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 sht_BAR_inf_BAT.Name Like CodePole Then sht_BAR_inf_BAT.Copy after:=newWbk.Sheets(newWbk.Sheets.Count): Exit For
            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 sht_CA_negatif.Name Like CodePole Then sht_CA_negatif.Copy after:=newWbk.Sheets(newWbk.Sheets.Count): Exit For
    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 sht_Agent_jour_BAT_diff_7.Name Like CodePole Then sht_Agent_jour_BAT_diff_7.Copy after:=newWbk.Sheets(newWbk.Sheets.Count): Exit For
    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 sht_Agent_nuit_BAT_diff_6h30.Name Like CodePole Then sht_Agent_nuit_BAT_diff_6h30.Copy after:=newWbk.Sheets(newWbk.Sheets.Count): Exit For
    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 sht_Param_BAR.Name Like CodePole Then sht_Param_BAR.Copy after:=newWbk.Sheets(newWbk.Sheets.Count): Exit For
    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 sht_RC_sup_100.Name Like CodePole Then sht_RC_sup_100.Copy after:=newWbk.Sheets(newWbk.Sheets.Count): Exit For
    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 sht_RTT_negatif.Name Like CodePole Then sht_RTT_negatif.Copy after:=newWbk.Sheets(newWbk.Sheets.Count): Exit For
    Next sht_RTT_negatif
    

 

    'sauvegarder et fermer le classeur spécifique à ce pole
    newWbk.SaveAs extractFolderPath & "\ANOMALIES_" & Replace(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_diff_7 = 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.Close: Set wbk_RC_sup_100 = Nothing
wbk_RTT_negatif.Close: Set wbk_RTT_negatif = Nothing

Set newWbk = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 

nat54

XLDnaute Barbatruc
Re : Regrouper des onglets selon leur nom [VBA]

Alors je viens de tester selon 2 méthodes :

>> lancement via le bouton où est affectée la macro
PLantage excel après 25 fichiers crées

>> lancement via alt F11 + le bouton "play"
a crée 6 fichiers complets
puis debogage (surlignage en jaune) sur ligne 78
sht_CA_negatif.Copy after:=newWbk.Sheets(newWbk.Sheets.Count)

la méthode copy de l'objet worksheet a échoué




j'ai été voir le fil dont tu as mis le lien, c'est là où tu parles de "add" plutôt que de "copy" ?
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 740
Messages
2 082 049
Membres
101 882
dernier inscrit
XaK_