Copie de plusieurs feuilles dans un nouveau classeur sans macro

bonjour tout le monde

sous excel 2016 j'ai un classeur xlsm avec plusieurs feuilles qui contiennent des macros dans les feuilles eux mêmes pas seulement les modules (peut pas faire autrement)

je voudrais créer un bouton qui me permet de copier les feuilles ("Hanifatoys", "Aternal", "Arba") vers un nouveau classeur dans fpath&fname

-1-et que ce nouveau classeur ne contient pas les macros des feuilles du fichier source (même en changeant l’extension pendant le "saveas" ça ne marche pas)

-2- et aussi si possible d'effacer(non cacher) les shapes qui portent le mêmes noms "AAA" des feuilles du nouveau classeur

-3- tout ça sans formules et sans links dans le nouveau classeur

merci

Multipost

oei,, bonjour,

* copier chaque feuille et coller avec pastespecial xlvalues

* chercher et déconnecter les links

* boucle des shapes et effacer ceux qui correspondent ce "AAA"

* saves avec fileformat 51 = effacer VBA complet

j'avais déja essayé avec des codes genres

Sub test001()
Worksheets(Array("Hanifatoys", "Aternal", "Arba")).Copy
With ActiveWorkbook .SaveAs FileName:=FPath & FName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
 .Close SaveChanges:=False
End With
End Sub
 '-------------------------------------------------
 Sub test002()
Application.DisplayAlerts = False
 'ThisWorkbook.Sheets.Copy
Sheets(Array("Hanifatoys", "Aternal", "Arba")).Copy
ActiveWorkbook.SaveAs FPath & FName & ".xlsx", 51
ActiveWorkbook.Close 
'With Workbooks(Array("Hanifatoys", "Aternal", "Arba"))
'.SaveAs ThisWorkbook.Path & "\copy_001.xlsx", 51
Application.DisplayAlerts = True
End Sub

ça me fait erreur dans le code du nouveau classeur

de même que

Dim ws As Worksheet

Show = Array("Hanifatoys", "Aternal", "Arba")

For Each ws In ActiveWorkbook.Worksheets(Show)
    With ws.UsedRange
        .value = .value
        End With
        Next ws
        For Each sShape In ActiveSheet.Shapes
    If sShape.Name = "AAA" Then sShape.Delete
    Next sShape
Show.SaveAs FileName:=chemin & "\" & FName

End Sub

re

Sub test001()
     mysheets = Array("Hanifatoys", "Aternal", "Arba")

     For Each sh In mysheets
          With Worksheets(sh)
               For Each sShape In .Shapes
                    If UCase(sShape.Name) = UCase("AAA") Then sShape.Delete
               Next sShape
          End With
     Next

     Worksheets(mysheets).Copy
     With ActiveWorkbook
          .SaveAs ThisWorkbook.Path & "\copy_" & Format(Now, "yymmdd_hhmmss"), 51
          Close 0
     End With
End Sub

merci BsAlv pour ton code mais j'ai une erreur 424 objet requis sur For Each sh In mysheets

j'arrive pas a régler ? merci encore et d'avance

re,

c'est un sujet sensible ... ! oubien utiliser "option Explicit" et declarer tous les variables oubien ne pas le faire.

2ième changement, dans le cas ou il n'y a pas de shapes dans une feuille, la construction "For i = 1 To .Shapes.Count" ne cause pas d'erreur.

Option Explicit

Sub test001()
     Dim MySheets, sh, sShape, i
     MySheets = Array("Hanifatoys", "Aternal", "Arba")

     For Each sh In MySheets
          With Worksheets(sh)
               For i = 1 To .Shapes.Count
               Set sShape = .Shapes(i)
                    If UCase(sShape.Name) = UCase("AAA") Then sShape.Delete
               Next
          End With
     Next

     Worksheets(MySheets).Copy
     With ActiveWorkbook
          .SaveAs ThisWorkbook.Path & "\copy_" & Format(Now, "yymmdd_hhmmss"), 51
          Close 0
     End With
End Sub

merci chef

mais la j'ai une erreur 9 mais le classeur est crée mais non enregistré

et le débogage pointe le code de la feuille copiée du nouveau classeur

donc le nouveau classeur contient les codes du fichier sources avant l'enregistrement en format :51

et puisque le code appel une feuille qui n'est pas dans le nouveau classeur d'où l'erreur ??

en enregistrant manuellement le nouveau classeur en format xlsx je me débarrasse des codes

les events causent des problemes, donc il faut les bloquer pour un instant.

Il faut que le fichier "Thisworkbook" soit sauvegardé (peut-être pas encore pour le moment, mais au moins une fois) , si non il n'y a pas de "path" connu !

Option Explicit

Sub BsAlv()
     Dim MySheets, sh, sShape, i
     MySheets = Array("Hanifatoys", "Aternal", "Arba")

     Application.EnableEvents = False     'interdit de réagir sur des events
     Worksheets(MySheets).Copy
     With ActiveWorkbook
          For Each sh In MySheets
               With .Worksheets(sh)     'je suppose que c'est dans le nouveau fichier que les shapes doivent disparaître, mais rester dans l'original !
                    For i = 1 To .Shapes.Count
                         Set sShape = .Shapes(i)
                         If UCase(sShape.Name) = UCase("AAA") Then
                              sShape.Delete
                         Else
                              MsgBox sh & " : le shape """ & sShape.Name & """ dans cellule " & sShape.TopLeftCell.Address & " n'est pas effacé"
                         End If
                    Next
               End With
          Next

          Application.DisplayAlerts = False     ' ne posez pas des questions
          .SaveAs ThisWorkbook.Path & "\copy_" & Format(Now, "yymmdd_hhmmss"), 51
          Application.DisplayAlerts = True
          Close 0
     End With
     Application.EnableEvents = True     'on peut de nouveau réagir sur des events
End Sub

merci BsAlv de ta réponse et désolé si j'ai tardé de répondre

en voyant que j'ai pas de solutions ,j'ai du refaire les codes des feuilles concernées à la copie dans un module a part et effacer les codes de ces feuilles

c’étaient des Sub Worksheet_Activate() pour l'update ainsi la copie sous xlsx marche parfaitement

merci encore