Copier/Coller Classeur en valeur sauf certaines feuilles

Bonjour à tous,

J'explique un peu plus le sujet par un ex:

J'ai un classeur de 20 onglets. Je souhaites faire une copie de ce classeur répartie comme suit: 18 onglets en valeur + 2 onglets qui gardent les formules.

J'ai déjà un code qui permet de TOUT passer en valeur. Mais comme je suis une bille en VBA, je ne sais lui dire de ne copier que certains onglets.

Le voici:

Sub testCopieValeursSeules()
Dim ws As Worksheet, wsArr(), NomFic$, nWBK As Workbook, i&
'création chaine pour nom du fichier
NomFic = ThisWorkbook.Path & "\" & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " - Suivi hebdo reps"
ReDim wsArr(0)
'création d'un tableau avec le noms des feuilles choisies
For Each ws In ThisWorkbook.Worksheets
'on exclut deux feuilles dans la liste selon leur nom
   If Not ws.Name = "YTD_TCD" And Not ws.Name = "WTD" And Not ws.Name = "TCD_NEW_SAF" And Not ws.Name = "Région" And Not ws.Name = "TABLE REPS" And Not ws.Name = "Productivité" Then
    wsArr(UBound(wsArr)) = ws.Name
    ReDim Preserve wsArr(UBound(wsArr) + 1)
    End If
    Next ws
ReDim Preserve wsArr(UBound(wsArr) - 1)
'on créee une copie du classeur ne contenant que les feuilles désirées
Sheets(wsArr).Copy
Set nWBK = ActiveWorkbook
'le contenu de toutes les feuilles passe en valeurs seules
For i = 1 To nWBK.Worksheets.Count
With nWBK.Worksheets(i)
.UsedRange.Value = .UsedRange.Value
End With
Next i
'ici ajouter ton code pour sauvegarder la copie
nWBK.SaveAs NomFic & ".xlsx", xlOpenXMLWorkbook
nWBK.Close
End Sub

Je pense qu'au niveau de la partie "'le contenu de toutes les feuilles passe en valeurs seules", il est possible de lui indiquer que 2 (ou plus) onglets (dont j'écrirai le(s) nom(s)). Mais incapable de le faire.

Merci beaucoup

Jean

Bonjour

Un essai à tester. Te convient-il ?

Bye !

17classeur1.xlsm (46.04 Ko)

Bonjour,

Une autre proposition à étudier.

Cdlt.

13liljuan.xlsm (22.97 Ko)
Option Explicit

Public Sub CopyWorkbook()
Dim ws As Worksheet, sFile As String
    sFile = ThisWorkbook.Path & "\" & Format(Date, "dd-mm-yyyy") & " - Suivi hebdo reps"
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs Filename:=sFile, FileFormat:=51
    For Each ws In ActiveWorkbook.Worksheets
        Select Case ws.Name
            Case "Feuil1", "Feuil2":
            Case Else: ws.UsedRange.Value = ws.UsedRange.Value
        End Select
    Next ws
    ActiveWorkbook.Save
End Sub

Merci a vous deux !

Je testerai lundi au bureau.

Bon weekend,

Jean

Salut à tous,

En mélangeant les deux codes, j'obtiens parfaitement ce que je veux.

Pour cela merci

En revanche, et pour pousser le truc à la fin, lorsque le nouveau classeur se créé, le format des valeurs diffère du format original.

Auriez-vous une idée de pourquoi ?

Ex:

  • format initial: 13 590€
  • format nouveau fichier: €13 590,00
Sub CopieValeursSeules()
Dim ws As Worksheet, wsArr(), NomFic$, nWBK As Workbook, i&
'création chaine pour nom du fichier
NomFic = ThisWorkbook.Path & "\" & Month(Date) - 1 & "-" & Year(Date) & " - RGC"
ReDim wsArr(0)
'création d'un tableau avec le noms des feuilles choisies
For Each ws In ThisWorkbook.Worksheets
'on exclut deux feuilles dans la liste selon leur nom
   If Not ws.Name = "TABLE" Then
    wsArr(UBound(wsArr)) = ws.Name
    ReDim Preserve wsArr(UBound(wsArr) + 1)
    End If
    Next ws
ReDim Preserve wsArr(UBound(wsArr) - 1)
'on créee une copie du classeur ne contenant que les feuilles désirées
Sheets(wsArr).Copy
Set nWBK = ActiveWorkbook
'le contenu de toutes les feuilles passe en valeurs seules

For Each ws In ActiveWorkbook.Worksheets
        Select Case ws.Name
            Case "Sommaire", "Christophe", "Francois", "Catherine", "Frederic", "Thierry", "TCD", "TCD_POS", "BDG", "TABLES":
            Case Else: ws.UsedRange.Value = ws.UsedRange.Value
        End Select
    Next ws

'ici ajouter ton code pour sauvegarder la copie
nWBK.SaveAs NomFic & ".xlsx", xlOpenXMLWorkbook
nWBK.Close
End Sub

Merci beaucoup !!

Jean

Bonjour,

Oups !... erreur.

Rechercher des sujets similaires à "copier coller classeur valeur sauf certaines feuilles"