copier avec le même format de cellules

**tompom3108** · 05/12/2011, 13h26

Bonjour à toutes et à tous,

J'ai le code ci dessous qui copie la valeur de cellules d'un classeur dans un autre, cependant le format source (format nombre à 3 décimales) n'est pas conservé et il est transformé en format texte dans le classeur de destination qu'elqu'un peut il me dire pourquoi? j'ai essayé le code formatNum "0.00" ça n'a pas marché
merci d'avance

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Sub envoiprod()
    Dim wsDevis As Worksheet
    Dim wbArchive As Workbook
    Dim wsArchive As Worksheet
 
    Set wsDevis = ThisWorkbook.Worksheets("Devis")
    Set wbArchive = Workbooks.Open("C:\Users\tpomies\Desktop\VBA\TabProd.xlsx")
    Set wsArchive = wbArchive.Worksheets("Ptour")
 
    Dim premiereLigneVide As Integer
    premiereLigneVide = wsArchive.Cells(wsArchive.Rows.Count, 1).End(xlUp).Row + 1
 
    Dim Num_Fact As String
    Dim Nom_client As String
    Dim Nom_Chantier As String
    Dim Nb_Pierre As Integer
    Dim Reference_Produit As String
    Dim Qualité As String
    Dim Longueur As String
    Dim Epaisseur As String
    Dim Hauteur As String
    Dim Quantité As String
    'Dim Volume As String
 
 
    Num_Fact = wsDevis.Range("F19").Value
    Nom_client = wsDevis.Range("J13").Value
    Nom_Chantier = wsDevis.Range("H21").Value
    Nb_Pierre = wsDevis.Range("F21").Value
 
 
    Dim iRow As Integer
 
    For iRow = PREMIERE_LIGNE To DERNIERE_LIGNE
        If wsDevis.Cells(iRow, 1).Value <> 0 Then
            Reference_Produit = wsDevis.Cells(iRow, 3).Value
            Selection.NumberFormat = "0.000"
            Qualité = wsDevis.Cells(iRow, 2).Value
            Selection.NumberFormat = "0.000"
            Longueur = wsDevis.Cells(iRow, 4).Value
            Selection.NumberFormat = "0.000"
            Epaisseur = wsDevis.Cells(iRow, 5).Value
            Selection.NumberFormat = "0.000"
            Hauteur = wsDevis.Cells(iRow, 6).Value
            Selection.NumberFormat = "0.000"
            Quantité = wsDevis.Cells(iRow, 7).Value
            Selection.NumberFormat = "0.0"
            'Volume = wsDevis.Cells(iRow, 10).Value
 
 
            wsArchive.Cells(premiereLigneVide, 1).Value = Num_Fact
            wsArchive.Cells(premiereLigneVide, 2).Value = Nom_client
            wsArchive.Cells(premiereLigneVide, 3).Value = Nom_Chantier
            wsArchive.Cells(premiereLigneVide, 4).Value = Nb_Pierre
            wsArchive.Cells(premiereLigneVide, 7).Value = Qualité
            wsArchive.Cells(premiereLigneVide, 8).Value = Reference_Produit
            wsArchive.Cells(premiereLigneVide, 9).Value = Longueur
            wsArchive.Cells(premiereLigneVide, 10).Value = Epaisseur
            wsArchive.Cells(premiereLigneVide, 11).Value = Hauteur
            wsArchive.Cells(premiereLigneVide, 12).Value = Quantité
 
            'wsArchive.Cells(premiereLigneVide, 13).Value = Volume
 
 
 
            premiereLigneVide = premiereLigneVide + 1
        End If
    Next iRow
    wbArchive.Saved = False
    wbArchive.Close
End Sub

Longueur, épaisseur ect doivent être en format nombre.

**SfJ5Rpw8** · 05/12/2011, 13h35

bonjour,
il faut éviter d'utiliser l'objet selection pour autre chose qu'une interaction (saisie..paramétres.. ) avec l'utilisateur..

de plus applique ton format de cellule directement à la cellule destination

Code :

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

 wsArchive.Cells(premiereLigneVide, 9).NumberFormat = "0.0"

**Daniel.C** · 05/12/2011, 13h36

Bonjour,

Peut-être :

Code :

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

1
2
3
4
    For iRow = PREMIERE_LIGNE To DERNIERE_LIGNE
        If wsDevis.Cells(iRow, 1).Value <> 0 Then
            Reference_Produit = wsDevis.Cells(iRow, 3).Value
            Reference_Produit.NumberFormat = "0.000"

etc.
au lieu de :

Code :

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

1
2
3
4
    For iRow = PREMIERE_LIGNE To DERNIERE_LIGNE
        If wsDevis.Cells(iRow, 1).Value <> 0 Then
            Reference_Produit = wsDevis.Cells(iRow, 3).Value
            Selection.NumberFormat = "0.000"

puisque, si j'ai bien lu, tu sélectionnes rien (et c'est bien !).

**gFZT82** · 05/12/2011, 14h25

Bonjour,

Pour appliquer le format voulu dans le classeur de destination, tu peux utiliser la forme

Code :

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

wsArchive.Cells(premiereLigneVide, 8).Value = Format(Reference_Produit, "0.000")

Cordialement.

**tompom3108** · 05/12/2011, 16h49

ok merci à tous

**Daniel.C** · 05/12/2011, 21h11

@ gfzt82 :

La fonction "Format" renvoie une chaîne texte, ce qui n'est peut-être pas approprié, dans ce cas (c'est l'équivalent de la fonction Excel "TEXTE").

**gFZT82** · 05/12/2011, 22h35

@ Daniel.C

Bien vu !

Effectivement, c'est une boulette ...

Cordialement.

copier avec le même format de cellules [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager