[XL-2003] copier en gardant la mise en forme d'arrivée [Résolu]

[spico45]

Bonjour à tous,

voici mon code

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
Private Sub CommandButton1_Click()
 
Dim ligdeb As Long, ligfin As Long
Dim ligdeb2 As Long, dercol As Long
Dim typ As String
Dim c As Range
Dim ws As Worksheet
 
Set ws = Sheets("" & Range("c2").Value & "")
 
    If Range("c2").Value <> "" And Range("c3").Value <> "" Then
        typ = "" & Range("c3").Value
 
        Set c = ws.Columns("A:A").Find(typ, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            ligdeb2 = c.Row
 
dercol = ws.Cells(ligdeb2, Rows(ligdeb2).Cells.Count).End(xlToLeft).Column + 1
 
ligdeb = Range("c8").End(xlDown).Row
ligfin = Range("c18").End(xlUp).Row
Range("c" & ligdeb, "c" & ligfin).Copy ws.Cells(ligdeb2, dercol)
Range("c5", "c7").Copy ws.Cells(ligdeb2 - 3, dercol)
 
        End If
    End If
 
End Sub

je souhaiterais lors ma copie garder le format d'arrivée et pas celui de départ, j'ai essayer de rajouter un code lors de la copie mais ca ne fonctionne pas.

Merci

[mercatog]

Code :

ws.range(ws.Cells(ligdeb2 - 3, dercol),ws.cells(ligdeb2-1,dercol)).value=Range("c5:c7").value

Range(B).value=range(A).value
A et B doivent être de même dimension
et ne pas oublier le .value

[spico45]

Merci mais ca ne fonctionne pas.

Tu me dis que Range(B).value=Range(A).value et que A et B doivent être de même dimension. Justement moi ma mise en forme d'arrivée est avec un format différent en taille, en plus il y a des bordures etc

j'ai trituré ton code dans tout les sens mais je crois ne pas trop le comprendre.

cordialement

[mercatog]

Quand tu fais

Code :

Range("c5", "c7").Copy ws.Cells(ligdeb2 - 3, dercol)

ça te copie C5:C7 (3cellules) dans ws à partir de Cells(ligdeb2 - 3, dercol) donc, les cellules de destination sont Cells(ligdeb2 - 3, dercol),Cells(ligdeb2 - 2, dercol) et Cells(ligdeb2 - 1, dercol)
Ils ont bien la même dimension, C'est bien ça?
et avec .copy, il te copie même la mise en forme
Si tu désire garder la mise en forme des cellules de destination:

Code :

ws.range(ws.Cells(ligdeb2 - 3, dercol),ws.cells(ligdeb2-1,dercol)).value=Range("c5:c7").value

répond à ta demande.

La traduction fidèle de ton code donne 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
Private Sub CommandButton1_Click()
Dim ligdeb As Long, ligfin As Long
Dim ligdeb2 As Long, dercol As Long
Dim typ As String
Dim c As Range
Dim ws As Worksheet
 
Set ws = Sheets(Range("C2").Value)
With ws
    If Range("C2").Value <> "" And Range("C3").Value <> "" Then
    typ = Range("C3").Value
 
    Set c = .Columns("A:A").Find(typ, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        ligdeb2 = c.Row
        Set c = Nothing
        dercol = .Cells(ligdeb2, .Columns.Count).End(xlToLeft).Column + 1
 
        ligdeb = Range("C8").End(xlDown).Row
        ligfin = Range("C18").End(xlUp).Row
        .Range(.Cells(ligdeb2, dercol), .Cells(ligdeb2 + ligfin - ligdeb, dercol)).Value = Range("C" & ligdeb & ":C" & ligfin).Value
        .Range(.Cells(ligdeb2 - 3, dercol), .Cells(ligdeb2 - 1, dercol)).Value = Range("C5:C7").Value
    End If
End If
End With
Set ws = Nothing
End Sub

Si ça ne fonctionne pas comme tu le désire, je crois fermement que ça vient de la veleur de tes variables ligdeb, ligfin, ligdeb2 et dercol As Long.
à toi de faire un pas pas F8 pour vérifier.

Quand je dis que les ranges A et B doivent être de même taille, ça veut dire le même nombre de lignes et de colonnes (attention peut être aux cellules fusionnées)

[imaril]

Pourquoi ne pas utiliser la fonction paste special "utiliser le format de destination" :

Code :

.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone,     SkipBlanks:=False, Transpose:=False

?

[mercatog]

Le pastspécial est aussi adapté. la différence, pas obligé de passer par le presse papier pour l'affectation directe.
question de choix

[spico45]

meci mercatog, ta phrase de code fonctionnait très bien, c'est juste que je ne l'avais pas compris ce matin (8h j'ai encore la tête dans le paté)

Et pastespecial je l'avais essayer mais ca ne marchait pas.

Merci