Discussion :

[azertix]

Bonjour.
Existe-t'il un moyen simple pour exporter un fichier Excel contenant plusieurs onglets vers un nouveau fichier Excel mais uniquement les valeurs (pas de formules) ?

Merci d'avance à ceux qui me liront.

[pgz]

Bonjour.

Si Wbk1 est le classeur contenant les données au départ, on peut :
- créer Wbk2 nouveau classeur vide
- ajouter ou retirer des feuilles à Wbk2 pour que les 2 classeurs en aient le même nombre
- Pour chaque feuille de Wbk1 (par les index)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
set oRng = wbk1.Worksheets(i).UsedRange
wbk2.Worksheets(i).Range(oRng.Address).Value = oRng.Value
wbk2.Worsheets(i).Name = wbk1.Worsheets(i).Name

Cordialement,

PGZ

[azertix]

J'espérais qu'il y avait encore plus simple. Du genre un OutputTo avec une option "value only"
Merci pour ton bout de code parce que j'aurais fait la même chose mais en plus long

[azertix]

Hello. J'ai pondu le code suivant mais l'exécution s'arrête lors de la fermeture avec enregistrement de mon fichier :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub cmdExportValeur_QuandClic()
'    On Error Resume Next
 
    Dim xls As Excel.Application
    Dim wkb As Workbook
    Set xls = CreateObject("Excel.Application")  ' création d'une nouvelle instance vierge de l'application Excel
 
    xls.Application.SheetsInNewWorkbook = 1
    Set wkb = xls.Workbooks.Add ' ajout d'un classeur Excel
 
    ' parcours des feuilles
    Dim i As Integer
    Dim rng As Range
    xls.Worksheets.Add , , Worksheets.Count - 1
    For i = 1 To Worksheets.Count
        xls.Worksheets(i).Name = Worksheets(i).Name ' affectation du nom
        ' copie des données
        Set rng = Worksheets(i).UsedRange
        rng.Copy
        xls.Worksheets(i).Range(rng.Address).PasteSpecial xlPasteValuesAndNumberFormats, , True
        xls.Worksheets(i).Range(rng.Address).PasteSpecial xlPasteColumnWidths
        Application.CutCopyMode = False
    Next i
 
    Dim nomfic As String
    nomfic = ActiveWorkbook.Path & "\" & Worksheets(1).Range("B4").Value & " - Contrôles 2 2 C - " & Worksheets(1).Range("B5").Value & ".xls"
    wkb.Worksheets(1).Activate
    wkb.Close True, nomfic
 
    Set xls = Nothing
    Set wkb = Nothing
    Set rng = Nothing
End Sub

D'autre part, je ne parviens pas à copier la hauteur des lignes

[pgz]

Bonsoir.

Finalement tu ne veux pas copier que les valeurs, mais tout, sauf les formules qui sont à remplacer par les valeurs du moment.

Dans ce cas, si le code est dans le classeur qui contient les données, je te conseille plutôt de créer un nouveau classeur en y copiant toutes les feuilles du premier.

Ensuite, dans le deuxième classeur, pour chaque feuille, tu fais

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

WbkNew.Worksheets(i).Formulalocal = wbkNew.Worksheets(i).Value

Cela devrait être plus rapide et pas d'ennui avec les formats.

Note : tu as créé le nouveau classeur dans une nouvelle appli : pas bon pour faire des copies.

Cela devrait donner qqc comme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub cmdExportValeur_QuandClic()
 
    Dim wkbNew As Excel.Workbook
    Dim i As Integer
    Dim nomfic As String
 
 
 
    Application.SheetsInNewWorkbook = 1
    Set wkbNew = Application.Workbooks.Add ' ajout d'un classeur Excel
    nomfic = ActiveWorkbook.Path & "\" & ThisWorkbook.Worksheets(1).Range("B4").Value & " - Contrôles 2 2 C - " & ThisWorkbook.Worksheets(1).Range("B5").Value & ".xls"
 
    ' parcours des feuilles
    For i = 1 To ThisWorkbook.Worksheets.Count
        ThisWorkbook.Worksheets(i).Copy , wkbNew.Worksheets(wkbNew.Worksheets.Count)
        wkbNew.Worksheets(i + 1).UsedRange.FormulaLocal = wkbNew.Worksheets(i + 1).UsedRange.Value
    Next i
 
    Application.DisplayAlerts = False
    wkbNew.Worksheets(1).Delete
    Application.DisplayAlerts = True
 
 
    wkbNew.Close True, nomfic
 
    Set wkbNew = Nothing
End Sub

Cordialement,

PGZ

[mercatog]

Ou simplement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Dim Sh As Worksheet
 
Application.ScreenUpdating = False
With ThisWorkbook
    For Each Sh In .Worksheets
        Sh.UsedRange.Value = Sh.UsedRange.Value
    Next Sh
    .SaveAs "Bis_" & .Name
End With