Copier onglets sans formules et en deux classeur différents

S

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

Lone-wolf

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

Bonjour susaita,

avant de commencer. Janvier et Février tu ne veux pas les prende en considération? Parce qu'en 2017, tu devra en faire de même pour ces deux mois.
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

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

Bonjour susaita, Lone-wolf, le forum,

Voyez le fichier joint et ces macros dans un module standard (Module1) :

Code: 
Sub Bouton()
Dim s As Object, dat As Date, F As Object
For Each s In Sheets
  If IsDate(s.Name) Then _
    If CDate(s.Name) > dat Then dat = CDate(s.Name): Set F = s
Next
If dat Then
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False 'si le fichier a déjà été créé
  CreerFichier Sheets("Facture"), F
  CreerFichier Sheets("ODA"), F
End If
End Sub

Sub CreerFichier(F1 As Object, F2 As Object)
F1.Copy
With ActiveWorkbook
  Set F1 = .ActiveSheet
  F1.DrawingObjects.Delete
  F2.Copy After:=F1
  .ActiveSheet.DrawingObjects.Delete
  .ActiveSheet.[A1].Select
  F1.Activate: F1.[A1].Select
  .SaveAs ThisWorkbook.Path & "\" & F1.Name & " " & F2.Name
  .Close
End With
End Sub
Nota : j'ai corrigé le nom de la feuille "Facture", il y avait un espace à la fin :rolleyes:

Bonne journée.
 

Pièces jointes

  • extraire sans formule(1).xlsm
    26.2 KB · Affichages: 50
Vote positif 0 Vote négatif
S

susaita

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

Bonjour Lone-wolf,
je prends pas en considérantion les mois précédents juste l'onglet facture avec l'onglet du dernier Mois dans un classeur qui sera nomé facture + noms du mois dans ce cas (facture Mars-2016)
puis un autre autre classeur avec un seul onglet c'est ODA
 
Vote positif 0 Vote négatif
S

susaita

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

Bonjour job75,
Merci pour ta réponse ton code marche bien il y'a juste deux petites remarques :
1- le 2ème classeur doit contenir juste l'onglet ODA et non pas ODA + Facture
2- les classeurs qui se crèent au bureau je veux qu'il soient ouvert après création si c'est possible

Cordialement,
 
Vote positif 0 Vote négatif
job75

job75

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

Re, bonjour chère ânesse,

Oui susaita, un seul onglet dans le 2ème classeur, et aussi vous ne voulez pas des formules je crois :

Code: 
Sub Bouton()
Dim s As Object, dat As Date, F As Object
With ThisWorkbook
  For Each s In .Sheets
    If IsDate(s.Name) Then _
      If CDate(s.Name) > dat Then dat = CDate(s.Name): Set F = s
  Next
  If dat Then
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False 'si le fichier a déjà été créé
    CreerFichier .Sheets("Facture"), F, True
    CreerFichier .Sheets("ODA"), F, False
    Application.ScreenUpdating = True
  End If
End With
Application.OnTime 1, "Activer" 'facultatif
End Sub

Sub CreerFichier(F1 As Object, F2 As Object, copie As Boolean)
F1.Copy
With ActiveWorkbook
  .ActiveSheet.UsedRange = F1.UsedRange.Value 'supprime les formules
  Set F1 = .ActiveSheet
  F1.DrawingObjects.Delete
  If copie Then
    F2.Copy After:=F1
    .ActiveSheet.UsedRange = F2.UsedRange.Value 'supprime les formules
    .ActiveSheet.DrawingObjects.Delete
  End If
  .ActiveSheet.[A1].Select
  F1.Activate: F1.[A1].Select
  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
End With
End Sub

Sub Activer()
ThisWorkbook.Activate
End Sub
Fichier (2).

A+
 

Pièces jointes

  • extraire sans formule(2).xlsm
    27.4 KB · Affichages: 48
Vote positif 0 Vote négatif
S

susaita

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

re Job,
Merci beaucoup mon ta reponse c'est exactement ce que je voulais mais une petite modification sur ce 2ème code :
les classeurs qui se crèent au bureau je ne veux plus qu'il soient ouvert je viens de constater que c'est moche
si non le reste est vraiment impec

je m'excuse pour le dérangement
 
Vote positif 0 Vote négatif
job75

job75

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

Re,

Code: 
Sub Bouton()
Dim s As Object, dat As Date, F As Object
With ThisWorkbook
  For Each s In .Sheets
    If IsDate(s.Name) Then _
      If CDate(s.Name) > dat Then dat = CDate(s.Name): Set F = s
  Next
  If dat Then
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False 'si le fichier a déjà été créé
    CreerFichier .Sheets("Facture"), F, True
    CreerFichier .Sheets("ODA"), F, False
  End If
End With
End Sub

Sub CreerFichier(F1 As Object, F2 As Object, copie As Boolean)
F1.Copy
With ActiveWorkbook
  .ActiveSheet.UsedRange = F1.UsedRange.Value 'supprime les formules
  Set F1 = .ActiveSheet
  F1.DrawingObjects.Delete
  If copie Then
    F2.Copy After:=F1
    .ActiveSheet.UsedRange = F2.UsedRange.Value 'supprime les formules
    .ActiveSheet.DrawingObjects.Delete
    .ActiveSheet.[A1].Select
  End If
  F1.Activate: F1.[A1].Select
  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 (3).

A+
 

Pièces jointes

  • extraire sans formule(3).xlsm
    27.2 KB · Affichages: 45
  • extraire sans formule(3).xlsm
    27.2 KB · Affichages: 46
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

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

Re,

C'est un détail mais j'ai quand même corrigé la macro du fichier (3).

.ActiveSheet.[A1].Select est plus à sa place à l'intérieur du If/End If.

A+
 
Vote positif 0 Vote négatif

Discussions similaires

_l_ours
  • Résolu(e)
XL 2016 Copier un onglet dans un nouveau classeur excel et l'enregistrer
Réponses
3
Affichages
204
sylvanu
sylvanu
Roseline
  • Question
Microsoft 365 Inputbox et deux conditions
Réponses
3
Affichages
205
Roseline
Roseline
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
174
marie3107
M
R
  • Résolu(e)
XL 2019 amélioration d'une macro (actualisation auto et automatisation)
Réponses
11
Affichages
330
rh.finances
R
Usine à gaz
  • Résolu(e)
XL 2021 Bloquer la sélection des autres onglets sous condition (sans les masquer)
Réponses
2
Affichages
267
Usine à gaz
Usine à gaz
Philou0607
  • Question
XL 2016 deplacer copier onglets vers nouveaux classeurs VBA
2
Réponses
24
Affichages
823
sylvanu
sylvanu
M
  • Résolu(e)
Microsoft 365 Gestion numéros de pages du classeur dans une cellule
2
Réponses
16
Affichages
564
sousou
sousou
J
  • Résolu(e)
XL 2021 plantage lors d'un export format PDF
Réponses
14
Affichages
298
JPaul78
J
CGU2022.
  • Résolu(e)
XL 2013 VBA copie feuille et colle sans Objet (Shape-Image)
Réponses
5
Affichages
705
CGU2022.
CGU2022.
Usine à gaz
  • Question
XL 2019 ouvrir un classeur en mode sans échec
Réponses
7
Affichages
476
Usine à gaz
Usine à gaz

Membres actuellement en ligne

1 membres et 27 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 348
Messages
2 087 508
Membres
103 568
dernier inscrit
NoS