XL 2016 Transfert feuilles vers nouveau classeur - Activation du contenu ?

[Philou0607]

Bonjour,
J'ai ce bout de code qui me permet de transférer certaines des feuilles souhaitées vers un nouveau classeur.

Sub EnregXLS()
Application.ScreenUpdating = False
Application.DisplayAlerts = False ' Masque le message " Ce fichier existe déjà ..."
For Each F In Worksheets
If F.Name <> "Entete" And F.Name <> "BASE_HS_2023" And F.Name <> "LISTE" And F.Name <> "TCD" And F.Name <> "Prev_Mens_Envel_2023" Then
Chemin = "R:\10 Etudes Temps Travail\11 - HEURES SUPPLÉMENTAIRES\00 - SUIVI CONSO HS & MASSE SALARIALE\001 - ANNEE 2023\ENVOI HS MENSUELLES SERVICES\Janvier à Avril 2023\" ' Chemin à définir. Doit se terminer par "\"
Nom = Chemin & F.Name & ".xlsx"
'Copie de la feuille courante dans un nouveau classeur et enregistrement
Sheets(F.Name).Select
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=Nom
ActiveWorkbook.Close
End If
Next F
Sheets("Entete").Select
Application.StatusBar = ""
Application.DisplayAlerts = True
End Sub


Mon fichier source est au format xlsm et comprend une base de données importante. Chaque feuille suivante dispose de formules essentiellement somme.si.ens avec des références absolues à la base de données précitée. Quand je récupère les feuilles transférées dans un nouveau dossier, je rencontre plusieurs difficultés :
1 - Avertissement de sécurité - Les connexions de données externes ont été désactivées (si j'active le contenu toutes mes cellules passent à #VALEUR#
2 - mon symbole monétaire est correct dans mon fichier source alors qu'il ne l'est pas dans la feuille transférée.

Merci pour votre aide
Philou0607

 

[Gégé-45550]

Bonjour,
J'ai ce bout de code qui me permet de transférer certaines des feuilles souhaitées vers un nouveau classeur.

Sub EnregXLS()
Application.ScreenUpdating = False
Application.DisplayAlerts = False ' Masque le message " Ce fichier existe déjà ..."
For Each F In Worksheets
If F.Name <> "Entete" And F.Name <> "BASE_HS_2023" And F.Name <> "LISTE" And F.Name <> "TCD" And F.Name <> "Prev_Mens_Envel_2023" Then
Chemin = "R:\10 Etudes Temps Travail\11 - HEURES SUPPLÉMENTAIRES\00 - SUIVI CONSO HS & MASSE SALARIALE\001 - ANNEE 2023\ENVOI HS MENSUELLES SERVICES\Janvier à Avril 2023\" ' Chemin à définir. Doit se terminer par "\"
Nom = Chemin & F.Name & ".xlsx"
'Copie de la feuille courante dans un nouveau classeur et enregistrement
Sheets(F.Name).Select
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=Nom
ActiveWorkbook.Close
End If
Next F
Sheets("Entete").Select
Application.StatusBar = ""
Application.DisplayAlerts = True
End Sub


Mon fichier source est au format xlsm et comprend une base de données importante. Chaque feuille suivante dispose de formules essentiellement somme.si.ens avec des références absolues à la base de données précitée. Quand je récupère les feuilles transférées dans un nouveau dossier, je rencontre plusieurs difficultés :
1 - Avertissement de sécurité - Les connexions de données externes ont été désactivées (si j'active le contenu toutes mes cellules passent à #VALEUR#
2 - mon symbole monétaire est correct dans mon fichier source alors qu'il ne l'est pas dans la feuille transférée.

Merci pour votre aide
Philou0607

Bonjour,
Que se passe-t-il si vous essayez ce code ?

Sub EnregXLS()
Application.ScreenUpdating = False
Application.DisplayAlerts = False ' Masque le message " Ce fichier existe déjà ..."
For Each F In Worksheets
    If F.Name <> "Entete" And F.Name <> "BASE_HS_2023" And F.Name <> "LISTE" And F.Name <> "TCD" And F.Name <> "Prev_Mens_Envel_2023" Then
        Chemin = "R:\10 Etudes Temps Travail\11 - HEURES SUPPLÉMENTAIRES\00 - SUIVI CONSO HS & MASSE SALARIALE\001 - ANNEE 2023\ENVOI HS MENSUELLES SERVICES\Janvier à Avril 2023\" ' Chemin à définir. Doit se terminer par "\"
        Nom = Chemin & F.Name & ".xlsx"
        'Copie de la feuille courante dans un nouveau classeur et enregistrement
        Sheets(F.Name).Copy Nom
        Nom.Close savechanges:=True, Filename:= Nom
    End If
Next F
Sheets("Entete").Select
Application.StatusBar = ""
Application.DisplayAlerts = True
End Sub

Cordialement,

 

[Philou0607]

Bonjour Gégé,
Si j'essaye ce code, j'ai une erreur 1004 : la méthode Copy de la classe Worksheet a échoué
sur la ligne : Sheets(F.Name).Copy Nom

 

[cp4]

Bonjour Gégé,
Si j'essaye ce code, j'ai une erreur 1004 : la méthode Copy de la classe Worksheet a échoué
sur la ligne : Sheets(F.Name).Copy Nom

Bonjour @Philou0607, @Gégé-45550

@Philou0607 : Tu espérais quoi sans fichier? essaie comme ceci

F.copy Nom

 

[Philou0607]

Bonjour @Philou0607, @Gégé-45550

@Philou0607 : Tu espérais quoi sans fichier? essaie comme ceci

F.copy Nom

Désolé, j'aurais dû le préciser dans ma première discussion. J'exploite des données sensibles et les anonymiser prendrait du temps ; mais je peux le faire si c'est plus facile.

 

[Philou0607]

Bonjour @Philou0607, @Gégé-45550

@Philou0607 : Tu espérais quoi sans fichier? essaie comme ceci

F.copy Nom

Désolé même chose et même erreur

 

[job75]

Bonjour à tous,

Pour éviter l'avertissement de sécurité, voyez en remplaçant ces 4 lignes :

Sheets(F.Name).Select
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=Nom
ActiveWorkbook.Close

par :

F.Copy
ActiveSheet.UsedRange = F.UsedRange.Value 'supprime les formules
ActiveWorkbook.SaveAs Filename:=Nom, FileFormat:=51
ActiveWorkbook.Close

A+

 

[Philou0607]

Bonjour à tous,

Pour éviter l'avertissement de sécurité, voyez en remplaçant ces 4 lignes :

Sheets(F.Name).Select
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=Nom
ActiveWorkbook.Close

par :

F.Copy
ActiveSheet.UsedRange = F.UsedRange.Value 'supprime les formules
ActiveWorkbook.SaveAs Filename:=Nom, FileFormat:=51
ActiveWorkbook.Close

A+

Bonjour job75,
J'ai toujours une erreur 1004 sur la ligne : ActiveSheet.UsedRange = F.UsedRange.Value
"Nous ne pouivons pas modifier les cellules sélectionnées, car cela affecterait un tcd. Pour modifier le rapport, veuillez utiliser la liste des champs. Si vous essayez d'insérer ou de supprimer des cellules, nous vous conseillons de déplacer le tableau croisé dynamique, puis de réessayer.
Merci pour ton aide

 

[Philou0607]

Bonjour job75,
J'ai toujours une erreur 1004 sur la ligne : ActiveSheet.UsedRange = F.UsedRange.Value
"Nous ne pouivons pas modifier les cellules sélectionnées, car cela affecterait un tcd. Pour modifier le rapport, veuillez utiliser la liste des champs. Si vous essayez d'insérer ou de supprimer des cellules, nous vous conseillons de déplacer le tableau croisé dynamique, puis de réessayer.
Merci pour ton aide

En revanche, une nouvelle feuille xlsx s'ouvre bien dans un nouveau fichier xlsx mais n'est pas enregistré dans le nouveau dossier nommé Test. Cette feuille cible correspond à la première feuille qui doit être transférée. Le classeur en compte 23.

 

[job75]

Bonjour Philou0607, le forum,

"Nous ne pouivons pas modifier les cellules sélectionnées, car cela affecterait un tcd.

Alors il ne faut pas copier la feuille F mais ses cellules, remplacez :

Sheets(F.Name).Select
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=Nom
ActiveWorkbook.Close

par :

With Workbooks.Add(xlWBATWorksheet) 'nouveau document
    F.Cells.Copy 'copie les cellules
    ActiveCell.PasteSpecial xlPasteValues 'colle les valeurs
    ActiveCell.PasteSpecial xlPasteFormats 'colle les formats
    ActiveCell.Select
    .SaveAs Filename:=Nom, FileFormat:=51
    .Close
End With

Pour enregistrer dans le dossier "Test" mettez bien sûr ce nom dans la variable Chemin.

A+

 

[cp4]

Bonjour job75,
J'ai toujours une erreur 1004 sur la ligne : ActiveSheet.UsedRange = F.UsedRange.Value
"Nous ne pouivons pas modifier les cellules sélectionnées, car cela affecterait un tcd. Pour modifier le rapport, veuillez utiliser la liste des champs. Si vous essayez d'insérer ou de supprimer des cellules, nous vous conseillons de déplacer le tableau croisé dynamique, puis de réessayer.
Merci pour ton aide

Bonjour,

@Philou0607 : Chez moi fonctionne parfaitement. Un petit fichier

 

[job75]

Bonjour,

@Philou0607 : Chez moi fonctionne parfaitement.

A priori il y a un TCD dans la feuille copiée, d'où mon post #10...