XL 2016 Macro copie feuille avec USF

G

guiyom

XLDnaute Junior
Bonjour,

Je rencontre actuellement un problème avec une macro qui a pour fonction la copie d'une feuille de mon classeur.

Celle-ci fonctionné très bien jusqu'à l'ajout d'un USF que je n'arrive pas à lui faire prendre en charge.

En PJ un fichier simplifié illustrant le problème.

Cordialement

Edit : Plutôt que de créer une copie du USF avec la macro peut-être est-il plus simple de supprimer de la copie le contenu (visualiser le code) de la feuille "impropre" ? De cette façon l'appel de l'USF n'aura pas lieu.
 

Pièces jointes

  • test macro sav.xlsm
    59.4 KB · Affichages: 14
Dernière édition:
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Bonjour guiyom, le forum,

Oui vous pédalez allègrement dans la choucroute, voyez plutôt ceci :
Code: 
Sub sav()
Dim chemin$
chemin = ThisWorkbook.Path & "\" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Workbooks.Add(xlWBATWorksheet).Sheets(1)
    ThisWorkbook.Sheets("IMPROPRE").Cells.Copy .[A1]
    .[A1].Copy .[A1] 'allège la mémoire
    .Name = "Stock du " & .[O2] & "." & .[P2] & "." & .[Q2]
    .[K6,O2:Q2] = "" 'supprime les formules
    .Parent.SaveAs Filename:=chemin & .Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    .Parent.Close
End With
End Sub
L'enregistrement en .xlsx suffit puisqu'il n'y a pas de macro.

Bonne journée.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,

Autre solution :
Code: 
Sub sav()
Dim chemin$
chemin = ThisWorkbook.Path & "\" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False 'désactive les évènements
Sheets("IMPROPRE").Copy
With ActiveWorkbook.Sheets(1)
    .Name = "Stock du " & .[O2] & "." & .[P2] & "." & .[Q2]
    .[K6,O2:Q2] = "" 'supprime les formules
    .Parent.SaveAs Filename:=chemin & .Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    .Parent.Close
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
Les macros de la feuille sont supprimées puisqu'on enregistre en .xlsx.

A+
 
Vote positif 0 Vote négatif
G

guiyom

XLDnaute Junior
job75 à dit:
Re,

Autre solution :
Code: 
Sub sav()
Dim chemin$
chemin = ThisWorkbook.Path & "\" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False 'désactive les évènements
Sheets("IMPROPRE").Copy
With ActiveWorkbook.Sheets(1)
    .Name = "Stock du " & .[O2] & "." & .[P2] & "." & .[Q2]
    .[K6,O2:Q2] = "" 'supprime les formules
    .Parent.SaveAs Filename:=chemin & .Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    .Parent.Close
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
Les macros de la feuille sont supprimées puisqu'on enregistre en .xlsx.

A+
Cliquez pour agrandir...
Bonjour Job75

Encore une fois vous apporté réponse à mon problème.
Merci pour cette solution qui marche très bien, effectivement je n'avais pas pensé que sans le USF et les macros le format .xlsx convenait très bien.
C'est au final beaucoup plus propre que des "IF".

Cordialement
 
Dernière édition:
Vote positif 0 Vote négatif
G

guiyom

XLDnaute Junior
job75 à dit:
Re,

Autre solution :
Code: 
Sub sav()
Dim chemin$
chemin = ThisWorkbook.Path & "\" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False 'désactive les évènements
Sheets("IMPROPRE").Copy
With ActiveWorkbook.Sheets(1)
    .Name = "Stock du " & .[O2] & "." & .[P2] & "." & .[Q2]
    .[K6,O2:Q2] = "" 'supprime les formules
    .Parent.SaveAs Filename:=chemin & .Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    .Parent.Close
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
Les macros de la feuille sont supprimées puisqu'on enregistre en .xlsx.

A+
Cliquez pour agrandir...
Bonsoir,
Je up ce sujet afin d'avoir une information concernant la méthode utilisé.
Est-il possible de copier 2 feuilles d'un même classeur et les placer dans le même fichier de destination ?

J'ai tésté avec :

ThisWorkbook.Sheets(Array("IMPROPRE", "Feuil2")).Cells.Copy .[A1]

Mais je n'est pas obtenu le résultat escompté.
Cordialement
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Pour ajouter une feuille utilisez cette macro :
VB: 
Sub sav()
Dim chemin$
chemin = ThisWorkbook.Path & "\" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Workbooks.Add(xlWBATWorksheet).Sheets(1) 'nouveau document
    ThisWorkbook.Sheets("IMPROPRE").Cells.Copy .[A1] 'copier-coller à adapter
    .Name = "Stock du " & .[O2] & "." & .[P2] & "." & .[Q2]
    .[K6,O2:Q2] = "" 'supprime les formules
    With .Parent.Sheets.Add(After:=.Parent.Sheets(1)) 'ajout d'une feuille
        ThisWorkbook.Sheets("Feuil2").Cells.Copy .[A1] 'copier-coller à adapter
        .Name = "Bonsoir" 'nom à adapter
        .[A1].Copy .[A1] 'allège la mémoire
    End With
    .Activate
    .Parent.SaveAs Filename:=chemin & .Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    .Parent.Close
End With
End Sub
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, guyom, job75

job75
guiyom à dit:
Est-il possible de copier 2 feuilles d'un même classeur et les placer dans le même fichier de destination ?
Cliquez pour agrandir...
Sauf erreur de ma part, on peut copier plusieurs feuilles dans un nouveau classeur en une seule fois, non?
VB: 
Sub test() 'macro pour test uniquement
Dim Feuilles
Feuilles = Array("Feuil1", "Feuil3")
ThisWorkbook.Sheets(Feuilles).Copy
With ActiveWorkbook
  With .Sheets("Feuil1")
      .Name = "toto": .Range("A1:A11") = ""
  End With
  With .Sheets("Feuil3")
    .Name = "titi": .Range("A1:A11") = ""
  End With
End With
End Sub
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re,

Job75
C'est vrai, que si il faut rompre les liaisons, cela rajoute un peu de code.

VB: 
Sub test_III()
Dim Feuilles, wb As Workbook, i&, vLks As Variant
Feuilles = Array("Feuil1", "Feuil3")
ThisWorkbook.Sheets(Feuilles).Copy
Set wb = ActiveWorkbook
With wb
    On Error Resume Next
    vLks = .LinkSources(Type:=xlLinkTypeExcelLinks)
    On Error GoTo 0
      If Not IsEmpty(vLks) Then
        For i = 1 To UBound(vLks)
          .BreakLink Name:=vLks(i), Type:=1
        Next i
      End If
    With .Sheets("Feuil1"): .Name = "toto": .Range("A1:A11") = "": End With
    With .Sheets("Feuil3"): .Name = "titi": .Range("A1:A11") = "": End With
End With
End Sub

EDITION: J'oubliais qu'il y aussi le cas des plages nommées et des noms à supprimer dans la copie.
Cela commence à faire beaucoup de code en plus. ;)
 
Dernière édition:
Vote positif 0 Vote négatif
G

guiyom

XLDnaute Junior
Bonjour, Job75, Staple1600

Merci pour vos contributions.
Après avoir contourné le problème hier soir j'ai tout repris ce matin après avoir consulté vos posts.

J'ai retenu la solution que propose Job75 car simple évolution de la précédente méthode déjà mis en place.
Cela fonctionne parfaitement.

Encore merci
Cordialement
 
Vote positif 0 Vote négatif

Discussions similaires

halecs93
  • Résolu(e)
XL 2016 Copie transposée de planning
2
Réponses
24
Affichages
403
job75
job75
chris6999
  • Question
Microsoft 365 MACRO VBA - Extraire des listes à partir d'une boucle
Réponses
5
Affichages
193
chris6999
chris6999
H
  • Question
XL 2021 Macro copie données valeur à partir de premiere cellule vide
Réponses
3
Affichages
307
Hugues1976
H
D
  • Question
XL 2016 macro pour copier coller des cellules d'une feuille dans une autre feuille avec condition
Réponses
2
Affichages
247
Phil69970
Phil69970
C
  • Résolu(e)
XL 2021 filtrer données puis envoi sur une autre feuille
Réponses
3
Affichages
203
sylvanu
sylvanu
O
  • Question
Microsoft 365 Macro copier avec condition
Réponses
9
Affichages
391
Staple1600
Staple1600
D
  • Question
Microsoft 365 Filtrer sur une feuille protégée et avec code macro
Réponses
5
Affichages
137
dd_76
D
A
  • Résolu(e)
XL 2021 Macro de création mail de relance avec référence cellules
Réponses
4
Affichages
229
arnoldbrice19
A
D
  • Question
Autres recopie d'une saisie d'un nom sur une colonne d'un tableau avec condition et le mettre dans un autre tableau
Réponses
5
Affichages
367
Damilou
D
V
  • Question
Microsoft 365 Macro copie d une colonne avec incrémentation
Réponses
2
Affichages
199
Vibsa
V

Membres actuellement en ligne

17 membres et 261 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 097
Messages
2 085 257
Membres
102 842
dernier inscrit
Miguelita