Copier onglets sans formules et en deux classeur différents

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

  • extraire sans formule.xlsx
    13.1 KB · Affichages: 57
  • extraire sans formule.xlsx
    13.1 KB · Affichages: 48

job75

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

  • Facture 3(2).xlsm
    280.1 KB · Affichages: 54

job75

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

  • Facture 3(3).xlsm
    277.8 KB · Affichages: 52

susaita

XLDnaute Occasionnel
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: 39
  • Sans titre.jpg
    Sans titre.jpg
    36.6 KB · Affichages: 40
  • Sans titre 2.jpg
    Sans titre 2.jpg
    82.3 KB · Affichages: 35
  • Sans titre.jpg
    Sans titre.jpg
    36.6 KB · Affichages: 41

Robert

XLDnaute Barbatruc
Repose en paix
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...
 

job75

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

  • Facture 3(4).xlsm
    278.1 KB · Affichages: 49

susaita

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

susaita

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

  • Facture.zip
    207.9 KB · Affichages: 43
  • Facture.zip
    207.9 KB · Affichages: 45
Dernière modification par un modérateur:

job75

XLDnaute Barbatruc
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).
 

susaita

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

Bonjour JOB,
Je veux proteger juste les cellules ou j'ai des dates dans les colonnes D et E sauf pour la première feuille février-2015 qui ne doit pas être protégée
 

job75

XLDnaute Barbatruc
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 :rolleyes:

Bonne soirée.
 

job75

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

susaita

XLDnaute Occasionnel
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 ??
 

job75

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

Discussions similaires

Statistiques des forums

Discussions
312 529
Messages
2 089 368
Membres
104 148
dernier inscrit
VICVIC