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,
Une autre proposition à étudier.
Cdlt.
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.