XL 2016 Macro copie feuille avec USF

[guiyom]

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.

 

[guiyom]

Bon ne trouvant pas de solution à mon problème j'ai fait une parade nul et pas propre à base de If qui au final désactive l'appel du USF sur la copie.

 

[job75]

Bonjour guiyom, le forum,

Oui vous pédalez allègrement dans la choucroute, voyez plutôt ceci :

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.

 

[job75]

Re,

Autre solution :

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+

 

[guiyom]

Re,

Autre solution :

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+

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

 

[guiyom]

Re,

Autre solution :

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+

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

 

[job75]

Bonsoir guiyom,

Non, il faut ajouter une feuille dans le document de destination et la remplir en copiant la feuille "Feuil2".

A+

 

[guiyom]

Bonsoir guiyom,

Non, il faut ajouter une feuille dans le document de destination et la remplir en copiant la feuille "Feuil2".

A+

Bonsoir Job75,

Merci pour cette réponse rapide. je vais revoir mes plans du coup.

Cordialement.

 

[job75]

Pour ajouter une feuille utilisez cette macro :

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

 

[Staple1600]

Bonsoir le fil, guyom, job75

job75

Est-il possible de copier 2 feuilles d'un même classeur et les placer dans le même fichier de destination ?

Sauf erreur de ma part, on peut copier plusieurs feuilles dans un nouveau classeur en une seule fois, non?

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

 

[job75]

Bonsoir JM,

Oui tu as raison JM on peut copier en même temps plusieurs feuilles.

Mais ici (comme je l'ai fait sur une feuille au post #4) ce n'est pas bien fameux car cela crée des liaisons inopportunes.

A+

 

[Staple1600]

Re,

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

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.

 

[guiyom]

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