XL 2013 Macro VBA copie valeur d'un classeur avec exceptions

Juan · 3 Septembre 2015

Bonjour à tous,

Je me permets de vous écrire car je bloque sur un code VBA (je suis une quiche et pas vraiment autodidacte dans ce domaine).

Voici mon objectif :
Faire une copie/valeur d'un classeur entier excepté certains onglets qui doivent garder leurs formules.

Voici le code sur lequel je travaille :

Code:

Sub testCopieValeursSeules()
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) & " - Reporting Clients RGC"
ReDim wsArr(0)
'création d'un tableau avec le noms des feuilles choisies
For Each ws In ThisWorkbook.Worksheets
'on exclut une/plusieurs feuilles dans la liste selon leur nom
   If Not ws.Name = "YTD_TCD" 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 sauf quelques feuilles
For i = 1 To nWBK.Worksheets.Count
With nWBK.Worksheets(i)
    If ws.Name <> "TCD" Or ws.Name <> "TCD_POS" Then .UsedRange.Value = .UsedRange.Value
End If
End With
Next i
'ici ajouter ton code pour sauvegarder la copie
nWBK.SaveAs NomFic & ".xlsx", xlOpenXMLWorkbook
nWBK.Close
End Sub

Merci beaucoup pour votre aide!
Jean

job75 · 3 Septembre 2015

Re : Macro VBA copie valeur d'un classeur avec exceptions

Bonjour Juan,

Code:

Sub CopierFichier()
Dim chemin$, nomfich$, exclu, w As Worksheet
With ThisWorkbook
  chemin = .Path & "\" 'chemin à adapter
  nomfich = "TOTO.xlsm" 'nom du fichier à adapter
  exclu = Array("xxx", "yyy", "zzz") 'noms des feuilles exclues, à adapter
  Application.DisplayAlerts = False
  On Error Resume Next
  Workbooks(nomfich).Close 'sil est ouvert on le ferme
  On Error GoTo 0
  .Save
  .SaveAs chemin & nomfich, .FileFormat
  For Each w In .Worksheets
    If IsError(Application.Match(w.Name, exclu, 0)) _
      Then w.UsedRange = w.UsedRange.Value
  Next
  .Save
End With
End Sub

A+

Juan · 3 Septembre 2015

Re : Macro VBA copie valeur d'un classeur avec exceptions

Salut Job75, merci pr ton retour...

En revanche, tout ne marche pas comme prévu, notamment au niveau de l'enregistrement du nouveau fichier. Tu y trouveras en PJ un screenshot de l'erreur.

Voici le code utilisé:

Code:

Sub CopierFichier()
Dim chemin$, nomfich$, exclu, w As Worksheet
With ThisWorkbook
  chemin = .Path & "C:\Users\linierej\Desktop\ANGELIQUE\" 'chemin à adapter
  nomfich = "TOTO.xlsm" 'nom du fichier à adapter
  exclu = Array("xxx", "yyy", "zzz") 'noms des feuilles exclues, à adapter
  Application.DisplayAlerts = False
  On Error Resume Next
  Workbooks(nomfich).Close 'sil est ouvert on le ferme
  On Error GoTo 0
  .Save
  .SaveAs chemin & nomfich, .FileFormat
  For Each w In .Worksheets
    If IsError(Application.Match(w.Name, exclu, 0)) _
      Then w.UsedRange = w.UsedRange.Value
  Next
  .Save
End With
End Sub

Merci à toi,
Jean

job75 · 3 Septembre 2015

Re : Macro VBA copie valeur d'un classeur avec exceptions

Re,

Votre modif :

Code:

chemin = .Path & "C:\Users\linierej\Desktop\ANGELIQUE\" 'chemin à adapter

ne va pas du tout, je vous laisse chercher pourquoi.

Il faut travailler un peu soi-même si l'on veut progresser...

A+

XL 2013 Macro VBA copie valeur d'un classeur avec exceptions

Juan

XLDnaute Junior

job75

XLDnaute Barbatruc

Juan

XLDnaute Junior

Pièces jointes

job75

XLDnaute Barbatruc

Discussions similaires