Regrouper des onglets selon leur nom [VBA]

nat54

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
 
Trier par date Trier par votes
nat54

nat54

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

j'allais t'écrire, c'est nickel ca marche très bien

j'avais changé toute seule les noms des répertoires

ca prend 360 secondes

Code: 
Sub Creer_un_fichier_par_pole()
debut = Timer
Application.ScreenUpdating = False
fichiers = Array("POLE_BAR_incoherente_vs_BAT", "POLE_pb_badg_fac_pr_decpte_horaire", "POLE_pb_BAR_inf_BAT", "POLE_pb_CA_negatif", "POLE_pb_jour_BATp_diff_7_par_pole", "POLE_pb_nuit_BATp_diff_6h30", "POLE_pb_PARAM-BAR", "POLE_pb_RC_sup_100", "POLE_pb_RTT_negatif")
Dim wbinf As Workbook
Set wbinf = Workbooks.Open("I:\DRH\EFFECTIF\BO\Gestor\Exports_BO_provisoires" & "\POLE_pb_RC_inf_35.xls")
For Each sh In wbinf.Sheets
  CodePole = Replace(sh.Name, "PB RC ", "")
  SonNom = "ANOMALIES_" & CodePole & ".xls"
  Workbooks.Add (xlWBATWorksheet)
  ActiveWorkbook.SaveAs ("I:\DRH\EFFECTIF\BO\Gestor\Fichiers_par_pole\" & SonNom)
  sh.Cells.Copy Destination:=Workbooks(SonNom).Sheets(1).Cells
  Workbooks(SonNom).Sheets(1).Name = sh.Name & " " & "inf35"
  For n = LBound(fichiers) To UBound(fichiers)
    Workbooks.Open ("I:\DRH\EFFECTIF\BO\Gestor\Exports_BO_provisoires" & "\" & fichiers(n) & ".xls")
    With Workbooks(fichiers(n) & ".xls")
      For m = 1 To .Sheets.Count
         If InStr(.Sheets(m).Name, CodePole) <> 0 Then
            Workbooks(SonNom).Sheets.Add.Name = .Sheets(m).Name
            .Sheets(m).Cells.Copy Destination:=Workbooks(SonNom).Sheets(.Sheets(m).Name).Cells
         End If
      Next m
    End With
  Next n
  Workbooks(SonNom).Save
  Workbooks(SonNom).Close
Next sh
For n = LBound(fichiers) To UBound(fichiers)
  Workbooks(fichiers(n) & ".xls").Close
Next n
wbinf.Close
Application.ScreenUpdating = True
MsgBox (Timer - debut)
End Sub

je vais lire tes commentaires :)
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

R
  • Question
XL 2019 injecter fichier excel avec nom variable
Réponses
4
Affichages
429
job75
job75
KTM
  • Question
XL 2016 Utiliser La fonction GetOpenFilename
Réponses
8
Affichages
579
KTM
KTM
A
  • Question
XL 2019 Besoin d'aide pour copier les lignes d'un classeur et les coller dans un autre classeur par le bié d'un bouton (VBA)
Réponses
7
Affichages
748
aka100k
A
A
  • Question
Microsoft 365 VBA: importer dans un dossier avec un nom variable
Réponses
4
Affichages
743
A-F
A
tdo88
  • Résolu(e)
XL 2016 Erreur d'exécution 9 - L'indice n'appartient pas à la sélection (recherche de la dernière ligne vide d'une feuille)
Réponses
7
Affichages
2 K
tdo88
tdo88
A
  • Question
XL 2010 importer et exporter des données à des fichiers excel
Réponses
9
Affichages
2 K
job75
job75
Caroline ;-))
  • Question
XL 2010 extraire des onglets selon nom de l'onglet pour former un classeur distinct
Réponses
10
Affichages
1 K
Caroline ;-))
Caroline ;-))
T
  • Question
Copie plage entre classeurs VBA
Réponses
1
Affichages
881
gmb
G
B
  • Question
Parcourir des dossiers depuis VBA pour ouvrir une page excel, et fermer l'actuelle
Réponses
0
Affichages
866
benio
B
K
  • Question
Nommer des cellules avec le nom de feuille, pour plusieurs feuilles
Réponses
9
Affichages
1 K
job75
job75

Membres actuellement en ligne

16 membres et 275 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 177
Messages
2 085 976
Membres
103 076
dernier inscrit
LoneWolf90