Export Excel valeurs uniquement

Version imprimable

Voir 40 message(s) de cette discussion en une page

22/11/2010, 10h29
azertix

Export Excel valeurs uniquement

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.
22/11/2010, 10h44
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:

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
22/11/2010, 11h05
azertix

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

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

Code:

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 :(

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:

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:

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

Ou simplement

Code:

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

23/11/2010, 11h05
azertix

Bonjour pgz et mercatog.
Merci pour vos réponses.

mercatog : merci pour ta proposition mais elle ne répond pas totalement à mes besoins. De plus j'ai une erreur lors de l'exécution :(

pgz : Après cette modif, ça répond à ma demande et ça fonctionne correctement.

Bonne fin de journée à vous deux :ccool:
23/11/2010, 11h21
mercatog

Citation:

merci pour ta proposition mais elle ne répond pas totalement à mes besoins. De plus j'ai une erreur lors de l'exécution

J'aimerai bien connaître l'erreur.
Pourtant j'avais testé sur un fichier enregistré (NomInitial.xls)
La logique est de remplacer le contenu des plages utilisées de chaque feuille par leurs valeurs et d'enregistrer le fichier sous un autre nom. (bis_NomInitial.xls)
Il est primordial de sauvegarder le fichier original avant de lancer la macro (sinon tu perds ton fichier initial)
23/11/2010, 13h42
azertix

Re.
L'erreur est : "Erreur définie par l'application ou par l'objet".
La ligne pointée est : Sh.UsedRange.Value = Sh.UsedRange.Value
23/11/2010, 13h54
mercatog

Sur mon test ça fonctionne.
peut être mon fichier cobaye est simple (avec formules, cellules fusionnées, graphiques, feuille vide...)
Bon à voir
23/11/2010, 14h03
azertix

ReRe.
J'ai une nouvelle problématique : dans certaines feuilles j'ai des calculs en %.
Et bien il faudrait que pour ces cellules la formule reste :aie:
Si vous avez une solution à me proposer...

P.S : je pense que ton code fonctionne malgré l'erreur car j'ai remarqué que dans mon fichier, il n'y avait plus aucune formule :lol:
23/11/2010, 14h28
mercatog

Re,
Tu peux joindre un extrait non confidentiel de ton fichier, image de ton fichier réel.
parce que là, quelque chose qui m'échappe. J'ai fais le teste avec divers données et formules reportant des nombres sous différents formats (dont des %), des dates .....
23/11/2010, 16h37
pgz

Re,

Citation:

Envoyé par azertix

J'ai une nouvelle problématique : dans certaines feuilles j'ai des calculs en %.

Tout calcul produit un résultat qui peut être exprimé en %. Je ne vois pas ce qu'est un calcul de %.
Finalement, peux-tu spécifier les formules que tu veux garder, ou celles que tu veux remplacer par les valeurs calculées?

Cordialement,

PGZ
24/11/2010, 08h53
azertix

Hello !
Dans trois de mes 11 feuilles, il y a des données qui seront saisies à la main.
Par conséquent les formules permettant les calculs de % ne doivent pas être supprimées ou doivent être remises après traitement.
Ce sont des formules du genre :

Citation:

=(C9-C11)/C12

Bonjour.

Je te propose ceci

Code:

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
34
35
36
37
38
Sub cmdExportValeur_QuandClic()
 
    Dim wkbNew As Excel.Workbook
    Dim i As Integer
    Dim nomfic As String
    Dim vF as variant, vV as variant
    Dim l as long, c as integer
 
 
 
    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)
        vV = Thisworkbook.Worksheets(i).UsedRange.Value
        vF = Thisworkbook.Worksheets(i).UsedRange.FormulaLocal
        for l = 1 To Ubound(vV,1)
            For c = 1 to Ubound(vV,2)
                 If vF(l,c) LIKE "=(*-*)/*" Then vV(l,c) = vF(l,c)
            Next c
        next l
        wkbNew.Worksheets(i + 1).UsedRange.FormulaLocal = vV
    Next i
 
    Application.DisplayAlerts = False
    wkbNew.Worksheets(1).Delete
    Application.DisplayAlerts = True
 
 
    wkbNew.Close True, nomfic
 
    Set wkbNew = Nothing
    vV = Empty
    vF = Empty
End Sub

Pour l'idée, car je n'ai pas testé.

Cordialement,

PGZ

26/11/2010, 17h13
azertix

Bonsoir.
J'ai pris ton code, corrigé deux trois trucs mais dans l'idée ça marche niquel.

Un gros merci et bon WE :lahola:

Bonjour bonjour.
Mon utilisatrice vient de me signaler un bug un peu curieux.
En fait le contenu de certaines cellules est tronqué.
Alors j'ai fait quelques points d'arrêt et j'ai trouvé que cela venait de mon Copy.
Après analyse, je me suis rendu compte que le nombre de caractères copiés dans une cellule était de 255 maximum. Au-delà, le contenu est tronqué. Là, ça m'a fait tilt. Puissance de 2...
Limitation ?
Quelqu'un aurait des infos ?

Je remets mon code pour information :

Code:

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
34
35
36
37
38
39
40
41
42
Sub toto()
    Dim wkbNew As Excel.Workbook
    Dim i As Integer
    Dim cheminFic As String
    Dim vF As Variant, vV As Variant
    Dim l As Long, c As Integer
 
    Application.SheetsInNewWorkbook = 1
    cheminFic = ActiveWorkbook.Path & "\" & ThisWorkbook.Worksheets(1).Range("B4").Value & " - Contrôles 2 2 C - " & ThisWorkbook.Worksheets(1).Range("B5").Value & ".xls"
 
    Set wkbNew = Application.Workbooks.Add ' ajout d'un classeur Excel
 
    ' parcours des feuilles
    For i = 1 To ThisWorkbook.Worksheets.Count - 1
        ThisWorkbook.Worksheets(i + 1).Copy , wkbNew.Worksheets(wkbNew.Worksheets.Count)
 
        With wkbNew.Worksheets(i + 1)
 
            vV = .UsedRange.Value
            vF = .UsedRange.FormulaLocal
            For l = 1 To UBound(vV, 1)
                For c = 1 To UBound(vV, 2)
                     If vF(l, c) Like "=*/*" Or vF(l, c) Like "=MIN(*)" Then vV(l, c) = vF(l, c)
                Next c
            Next l
            .UsedRange.FormulaLocal = vV
        End With
    Next i
 
    Application.DisplayAlerts = False
    wkbNew.Worksheets(1).Delete
    wkbNew.Worksheets(1).Delete
    Application.DisplayAlerts = True
 
    wkbNew.Close True, cheminFic
 
    Set wkbNew = Nothing
    vV = Empty
    vF = Empty
 
    MsgBox "Export terminé.", vbOKOnly + vbInformation, "Opération réalisée avec succès..."
End Sub

Edit : Mes collègues me disent qu'il s'agit en effet d'une limitation dans Excel. Qu'ai-je comme option dans ce cas ?

17/01/2011, 17h53
pgz

Bonjour.

Citation:

Envoyé par azertix

En fait le contenu de certaines cellules est tronqué.
Alors j'ai fait quelques points d'arrêt et j'ai trouvé que cela venait de mon Copy.Edit : Mes collègues me disent qu'il s'agit en effet d'une limitation dans Excel. Qu'ai-je comme option dans ce cas ?

Tu es sûr? La seule méthode copy utilisée concerne la copie de feuilles, non?
Ce qui est tronqué, c'est quoi, du texte?

Citation:

Envoyé par azertix

Après analyse, je me suis rendu compte que le nombre de caractères copiés dans une cellule était de 255 maximum.
...
Mes collègues me disent qu'il s'agit en effet d'une limitation dans Excel. Qu'ai-je comme option dans ce cas ?

Je ne peux pas vérifier avec XL 2003, mais je ne vois rien de tel avec 2007 ou 2010. Si la cellule était limitée à 255 car, il n'y aurait aucune cellule contenant plus de 255 car à copier!

Peux-tu donner un exemple de troncature et dire à quel ligne du code elle apparaît?

Cordialement,

PGZ
18/01/2011, 09h04
azertix

Citation:

Envoyé par pgz

La seule méthode copy utilisée concerne la copie de feuilles, non?
Ce qui est tronqué, c'est quoi, du texte?

- Oui et il me semble bien que le problème vient de là car en mettant un point d'arrêt juste après, quand je regarde ce qui a été copié, la cellule est déjà tronquée.
- Oui enfin, je pense que si c'étaient des chiffres ce serait pareil.
Toujours est-il que ça coupe à 255 caractères.

Citation:

Envoyé par pgz

Je ne peux pas vérifier avec XL 2003, mais je ne vois rien de tel avec 2007 ou 2010. Si la cellule était limitée à 255 car, il n'y aurait aucune cellule contenant plus de 255 car à copier!

Peux-tu donner un exemple de troncature et dire à quel ligne du code elle apparaît?

- En fait, tu peux mettre plus de 255 caractères dans une cellule mais tu ne peux pas copier une feuille entière si l'une des cellules qu'elle contient comprend plus de 255 caractères.
À ce que m'ont dit mes collègues, quand on fait ça à la souris, ça gueule. En VBA, ça doit tout simplement tronquer les cellules qui sont trop volumineuses.
- Ben disons simplement que s'il y a plus de 255 caractères dans la cellule, ça coupe à cette limite.

Edit : Voilà l'erreur qui apparait lorsque j'essaye de copier à la main une des feuilles posant problème :
http://www.hebergementimages.com/ima...fad_erreur.gif

Bonjour.

Merci car maintenant cela me semble clair. Je crois qu'il est facile de pallier le pb, avec :

Code:

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
34
35
36
37
38
39
Sub toto()
    Dim wkbNew As Excel.Workbook
    Dim i As Integer
    Dim cheminFic As String
    Dim vF As Variant, vV As Variant
    Dim l As Long, c As Integer
 
    Application.SheetsInNewWorkbook = 1
    cheminFic = ActiveWorkbook.Path & "\" & ThisWorkbook.Worksheets(1).Range("B4").Value & " - Contrôles 2 2 C - " & ThisWorkbook.Worksheets(1).Range("B5").Value & ".xls"
 
    Set wkbNew = Application.Workbooks.Add ' ajout d'un classeur Excel
 
    ' parcours des feuilles
    For i = 1 To ThisWorkbook.Worksheets.Count - 1
        ThisWorkbook.Worksheets(i + 1).Copy , wkbNew.Worksheets(wkbNew.Worksheets.Count)
            vV =ThisWorkbook.Worksheets(i + 1).UsedRange.Value
            vF = ThisWorkbook.Worksheets(i + 1).UsedRange.FormulaLocal
 
            For l = 1 To UBound(vV, 1)
                For c = 1 To UBound(vV, 2)
                     If vF(l, c) Like "=*/*" Or vF(l, c) Like "=MIN(*)" Then vV(l, c) = vF(l, c)
                Next c
            Next l
            wkbNew.Worksheets(i + 1).UsedRange.FormulaLocal = vV
        Next i
 
    Application.DisplayAlerts = False
    wkbNew.Worksheets(1).Delete
    wkbNew.Worksheets(1).Delete
    Application.DisplayAlerts = True
 
    wkbNew.Close True, cheminFic
 
    Set wkbNew = Nothing
    vV = Empty
    vF = Empty
 
    MsgBox "Export terminé.", vbOKOnly + vbInformation, "Opération réalisée avec succès..."
End Sub

C'est-àdire : charger les tableaux avec le contenu des feuilles originales
Cordialement,

PGZ

Voir 40 message(s) de cette discussion en une page