Copier onglets sans formules et en deux classeur différents

  • Initiateur de la discussion Initiateur de la discussion susaita
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

susaita

XLDnaute Occasionnel
bonjour à tous,

sur l'exemple ci-joint je souhaite avoir un code qui me permet d'extraire dans un nouveau classeur et sans formule l'onglet Facture et le dernier onglet du fichier c'est à dire Mars-2016 sans les macros ni les boutons, ce premier classeur prendra comme nom Facture Mars 2016. et le même code extraira sur un 2ème classeur l'onglet ODA qui prendra comme nom ODA Mars-2016 (les deux classeurs produits seront sauvegardé sur le bureau).

et si par exemple je rajoute un autre mois par la suite (Avril-2016) et je clique sur ce code il extraira l'onglet Facture + l'onglet avril-2016 sur un classeur et l'onglet classeur ainsi de suite.

Merci d'avance
 

Pièces jointes

Re : Copier onglets sans formules et en deux classeur différents

Re,

Ce n'est pas normal, chez moi (Excel 2013) il n'y a pas ce problème.

Cela dit vous remarquerez que le fichier (1) précédent est vérolé : dans VBA il s'est créé une nouvelle feuille Feuil31 (Facture) et Feuil3 s'est transformée... en un 2ème ThisWorkbook !

J'ai recréé le fichier (2) ci-joint, sain a priori, testez de nouveau et dites-moi.

A+
 

Pièces jointes

Re : Copier onglets sans formules et en deux classeur différents

Re,

Je sais qu'Excel 2007 a quelques problèmes... Testez ce fichier (3) avec cette macro :

Code:
Sub CreerFichier(F1 As Object, F2 As Object, copie As Boolean)
Dim s As Shape, n As Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier a déjà été créé
F1.Copy
With ActiveWorkbook
  .ActiveSheet.UsedRange = F1.UsedRange.Value 'supprime les formules
  Set F1 = .ActiveSheet
  For Each s In F1.Shapes: s.Delete: Next s
  F1.Cells.Validation.Delete 'flèches de validation
  If copie Then
    F2.Copy After:=F1
    With .ActiveSheet
      .Protect mdp, UserInterfaceOnly:=True 'voir le module MotDePasse
      .UsedRange = F2.UsedRange.Value 'supprime les formules
      For Each s In .Shapes: s.Delete: Next s
      .Cells.Validation.Delete 'flèches de validation
      Application.GoTo .[A1], True 'cadre la cellule
    End With
  End If
  Application.GoTo F1.[A1], True 'cadre la cellule
  For Each n In .Names 'supprime les noms définis
    n.Visible = True 'facultatif, juste pour vérifier dans les fichiers créés
    If Not n.Name Like "_xlfn.*" Then n.Delete
  Next n
  On Error Resume Next 'quand le fichier n'est pas ouvert
  Workbooks(F1.Name & " " & F2.Name).Close False
  On Error GoTo 0
  .SaveAs ThisWorkbook.Path & "\" & F1.Name & " " & F2.Name
  .Close
End With
End Sub
A+
 

Pièces jointes

Re : Copier onglets sans formules et en deux classeur différents

toujours une erreur comme dans l'image ci-dessous 🙁
 

Pièces jointes

  • Sans titre 2.jpg
    Sans titre 2.jpg
    82.3 KB · Affichages: 43
  • Sans titre.jpg
    Sans titre.jpg
    36.6 KB · Affichages: 44
  • Sans titre 2.jpg
    Sans titre 2.jpg
    82.3 KB · Affichages: 39
  • Sans titre.jpg
    Sans titre.jpg
    36.6 KB · Affichages: 45
Re : Copier onglets sans formules et en deux classeur différents

Bonjour le fil, bonjour le forum,

Je comprend mieux maintenant pourquoi, dans un autre forum, tu t'es fait blacklister Susaita... Tu mets tellement de personnes à contribution, souvent avec des réponses qui te satisfont d'après les retours que tu fais, que ça devient écœurant de voir qu'on s'est décarcassé pour une personne comme toi...
 
Re : Copier onglets sans formules et en deux classeur différents

Re, hello Robert,

Pour moi pas de soucis 🙂

Pour terminer, ceci doit forcément marcher puisque ça marchait sur les 1ers fichiers :

Code:
Sub CreerFichier(F1 As Object, F2 As Object, copie As Boolean)
Dim n As Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier a déjà été créé
F1.Copy
With ActiveWorkbook
  .ActiveSheet.UsedRange = F1.UsedRange.Value 'supprime les formules
  Set F1 = .ActiveSheet
  F1.DrawingObjects.Delete
  F1.Cells.Validation.Delete 'flèches de validation
  If copie Then
    F2.Copy After:=F1
    With .ActiveSheet
      .Unprotect mdp 'voir le module MotDePasse
      .UsedRange = F2.UsedRange.Value 'supprime les formules
      .DrawingObjects.Delete
      .Cells.Validation.Delete 'flèches de validation
      Application.GoTo .[A1], True 'cadre la cellule
      .Protect mdp
    End With
  End If
  Application.GoTo F1.[A1], True 'cadre la cellule
  For Each n In .Names 'supprime les noms définis
    n.Visible = True 'facultatif, juste pour vérifier dans les fichiers créés
    If Not n.Name Like "_xlfn.*" Then n.Delete
  Next n
  On Error Resume Next 'quand le fichier n'est pas ouvert
  Workbooks(F1.Name & " " & F2.Name).Close False
  On Error GoTo 0
  .SaveAs ThisWorkbook.Path & "\" & F1.Name & " " & F2.Name
  .Close
End With
End Sub
Fichier (4).

A+
 

Pièces jointes

Re : Copier onglets sans formules et en deux classeur différents

re Job,
cette fois ça marché....
Merci beaucoup pour le temps que tu m'a accordé et surtout pour tes réponses....j'en suis vraiment reconnaissant..

Cordialement
Susaita
 
Re : Copier onglets sans formules et en deux classeur différents

Bonsoir JOB,
je vous contacte à nouveau pour une petite modification que vous avez faites sur le module newmonthsheet sans faire attention je crois ou peut etre que ca marche pas cette rectification sur ma version d'excel

la protection ne doit être présente sur la feuille du premier mois (Février-2015)...elle ne se fait qu'à partir du 2ème mois (Mars-2015) et juste pour les cellules des colonnes D & E qui sont remplisses déjà dans le mois précédent..
car si j'ai la premiere feuille protégé je ne pourrai pas saisir les dates d'entrée et sortie

ci-joint la dernière version
Bonne soirée
 

Pièces jointes

Dernière modification par un modérateur:
Re : Copier onglets sans formules et en deux classeur différents

Bonjour susaita,

Je n'ai rien fait de spécial dans la feuille NewMonthSheet à part remplacer "" par mdp.

Votre système de verrouillage des cellules (colonnes D:E) ne me paraît pas cohérent.

Il faudrait plutôt verrouiller les cellules où il y a des formules (I4, J4 et les colonnes B, F:G, J:N).
 
Re : Copier onglets sans formules et en deux classeur différents

Re,

La macro Worksheet_Activate de la feuille "Données" protège toutes les feuilles des mois.

Vous n'avez qu'à déprotéger la feuille "Février-2015" dans cette macro.

Je vous laisse faire car je n'aime pas faire des choses inutiles.

Et puis ça vous fera bosser un peu 🙄

Bonne soirée.
 
Re : Copier onglets sans formules et en deux classeur différents

Re,

Je vois qu'il ne faut pas essayer de vous fatiguer !

Code:
Private Sub Worksheet_Activate()
Dim w As Worksheet
For Each w In Worksheets
  If IsDate(w.Name) Then
    w.Protect mdp, UserInterfaceOnly:=True
    w.[A10:N1000].Sort w.[A10], Header:=xlNo
  End If
Next
Sheets("Février-2015").Unprotect mdp
End Sub
A+
 
Re : Copier onglets sans formules et en deux classeur différents

Merci beaucoup JOB pour votre réponse c'est fonctionnel mais l'onglet Février-2015 est Variable il se peut qu'il prenne un autre nom
y'a pas moyen pour qu'il soit aussi variable dans le code ??
 
Re : Copier onglets sans formules et en deux classeur différents

Re,

Bon allez la petite dernière :

Code:
Private Sub Worksheet_Activate()
Dim w As Worksheet
For Each w In Worksheets
  If IsDate(w.Name) Then
    If w.ProtectContents Then w.Protect mdp, UserInterfaceOnly:=True
    w.[A10:N1000].Sort w.[A10], Header:=xlNo
  End If
Next
End Sub
Bonne nuit.
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
3
Affichages
488
Retour