XL 2016 Supprimer Formules conserver données de plusieurs onglets

[BEN_NWP]

Bonjour à tous,

J'ai un petit blocage dans une de mes macros, étant novice je n'arrive pas à me démêler les pinceaux.
Alors je fais appel à votre aide.

Le code ci dessous permet l'enregistrement de trois onglets de mon fichier. "TDB", "DDE SCORE", "INTEGRATION"
Je souhaite que les trois onglets n'affichent que les valeurs pas les formules, le genre Selection.PasteSpecial mais cela ne fonctionne que pour le premier onglet. "TDB"
C'est dans la partie ci dessous nommée 'Suppression des formules

J'espère que je suis compréhensible et vous remercies par avance de l'aide que vous m'apporterez.

Bonne fin de journée à tous,

Sub EXPORT
'Gestion de l'enregistrement

Application.DisplayAlerts = False
Select Case MsgBox("Vous allez enregistrer le fichier destiné aux utilisateurs, selectionnez le répertoire afin de pouvoir l'ajouter en pièce jointe pour le diffuser", vbYesNo + vbQuestion, "Info Utilisateur")
Case vbYes

Dim Chemin As Variant, nomFichier As String, extension As String


Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choix du répertoire de Stockage", &H2&)

On Error GoTo Onerror

Set oFolderItem = objFolder.Items.Item
Chemin = oFolderItem.Path

Dim ClasseurSource As Workbook
Dim ClasseurCible As Workbook

Set ClasseurSource = ActiveWorkbook

Sheets(Array("TDB", "DDE SCORE", "INTEGRATION")).Copy

Set ClasseurCible = ActiveWorkbook

extension = ".xlsx"

'Suppression des formules

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Cells(1, 1).Select


With ActiveWorkbook

'Nomenclature enregistrement

.SaveAs Filename:=Chemin & Application.PathSeparator & Feuil1.Range("C9") & "_" & Feuil1.Range("A9") & "_" & Feuil1.Range("E9") & extension
.Close
End With


MsgBox "Sélectionnez le bouton 3. Diffusion mail et ajoutez la PJ que vous venez d'enregistrer."


Onerror::

Case vbNo
'procédure si on clique sur non
CreateObject("Wscript.shell").Popup "Le fichier n'a pas été enregistré", 3, "Info Utilisateur", vbExclamation


End Select
End Sub

 

[Staple1600]

Bonsoir le fil

Test OK sur mon PC

Sub Macro1()
'Gestion de l'enregistrement
Dim WBK_copie As Workbook, ws As Worksheet
Dim Chemin$, nomFichier As String, extension As String
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Application.DisplayAlerts = False
Set objShell = CreateObject("Shell.Application")
Select Case MsgBox("Vous allez enregistrer le fichier destiné aux utilisateurs, selectionnez le répertoire afin de pouvoir l'ajouter en pièce jointe pour le diffuser", vbYesNo + vbQuestion, "Info Utilisateur")
Case vbYes
Sheets(Array("TBD", "DDE SCORE", "INTEGRATION")).Copy
Set WBK_copie = ActiveWorkbook
For Each ws In WBK_copie.Worksheets
ws.UsedRange = ws.UsedRange.Value
Next
Set objFolder = objShell.BrowseForFolder(&H0&, "Choix du répertoire de Stockage", &H2&)
Set oFolderItem = objFolder.Items.Item
Chemin = oFolderItem.Path
WBK_copie.SaveAs Chemin & "\" & "test1.xlsx", 51
WBK_copie.Close True
Case vbNo
'procédure si on clique sur non
CreateObject("Wscript.shell").Popup "Le fichier n'a pas été enregistré", 3, "Info Utilisateur", vbExclamation
Exit Sub
End Select
End Sub

Je te laisse finaliser selon ton desiderata (au niveau du nom du fichier)