Regrouper des onglets selon leur nom [VBA]

nat54 · 29 Décembre 2009

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 · 29 Décembre 2009

Re : Regrouper des onglets selon leur nom [VBA]

ok merci de ton aide

là je fais le pas à pas avec F8
mais à chaque fois vu qu'il teste les 31 onglets c'est long

nat54 · 29 Décembre 2009

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

)

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 · 29 Décembre 2009

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 · 29 Décembre 2009

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 · 29 Décembre 2009

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

nat54 · 29 Décembre 2009

Re : Regrouper des onglets selon leur nom [VBA]

merci de t'y être penché tout de même

j'étais passée à qqch d'urgent donc je regarde demain

Pierrot93 · 29 Décembre 2009

Re : Regrouper des onglets selon leur nom [VBA]

Re

tiens, j'ais également retrouvé un ancien fil ou il est question de bogue lors de copies multiples d'onglet par vba.

https://www.excel-downloads.com/threads/recopie-modele-et-le-renomme.99850/

Etrange tout de même que ce soit toujours le même fichier qui bogue....

bonne soirée
@+

pierrejean · 29 Décembre 2009

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

Pierrot93 · 29 Décembre 2009

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.

nat54 · 30 Décembre 2009

Re : Regrouper des onglets selon leur nom [VBA]

bonjour le fil,

je vais tester de ce pas mais je tenais à dire que comme pierrejean ca me fait un plantage excel
"excel a rencontré une erreur et va être fermé"

Pierrot93 · 30 Décembre 2009

Re : Regrouper des onglets selon leur nom [VBA]

Bonjour Nat, PierreJean

point commun, vous êtes tous les 2 sur excel 2000, selon vos profils...

bonne journée
@+

nat54 · 30 Décembre 2009

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

Pierrot93 · 30 Décembre 2009

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 · 30 Décembre 2009

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

nat54 · 30 Décembre 2009

Re : Regrouper des onglets selon leur nom [VBA]

quand je ré-essaie là, ca a planté au bout de 2 fichiers
sûrement un pb de mémoire...

Effectuez une recherche sur Excel Downloads...

Regrouper des onglets selon leur nom [VBA]

nat54

XLDnaute Barbatruc

nat54

XLDnaute Barbatruc

nat54

XLDnaute Barbatruc

Pierrot93

XLDnaute Barbatruc

Pierrot93

XLDnaute Barbatruc

Pierrot93

XLDnaute Barbatruc

nat54

XLDnaute Barbatruc

Pierrot93

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

Pierrot93

XLDnaute Barbatruc

nat54

XLDnaute Barbatruc

Pierrot93

XLDnaute Barbatruc

nat54

XLDnaute Barbatruc

Pièces jointes

Pierrot93

XLDnaute Barbatruc

nat54

XLDnaute Barbatruc

nat54

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums