copier une cellule sans modifier la mfc

Version imprimable

Bonjour,
j'ai un code qui paraît fonctionner sauf que la mise en forme de la feuille de destination est transformé et je voudrais la garder.

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
Sub mis_jour_Numcom()
 
Dim Wbsourc As Workbook, Wbdest As Workbook
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim LigneDebut As Byte
Dim lignefin As Long
Dim cible1 As String
Dim Rci As Range, Lign As Integer
 
 
    Set Wbsourc = ThisWorkbook
    Set Wbdest = Workbooks("planning.xlsm")
    Set Ws1 = Wbsourc.Worksheets("CC2012")
    Set Ws2 = Wbdest.Worksheets("P2")
 
    LigneDebut = 4
    lignefin = Ws1.Range("G" & Ws1.Rows.Count).End(xlUp).Row
    'On balaye la colonne B de la feuille P1
    For Lign = LigneDebut To lignefin
        'Valeur à rechercher : Cible1
        cible1 = Ws1.Cells(Lign, 1).Value
        'Cherche la valeur dans la feuille P2, en colonne B
        Set Rci = Ws2.Columns(2).Find(What:=cible1, LookAt:=xlPart)
        'Si on trouve
        If Not Rci Is Nothing Then
            'Copie la plage
            Ws1.Cells(Lign, 5).Copy Destination:=Ws2.Range("C" & Rci.Row)
            Ws1.Cells(Lign, 7).Copy Destination:=Ws2.Range("E" & Rci.Row)
        End If
    Next Lign
    Set Wbdest = Nothing
    Set Ws1 = Nothing
    Set Ws2 = Nothing
End Sub

Je voudrais également modifier les conditions de copie, car sur ws1.cells(lign, 5) j'ai une formule du type "=SI(A24<>"";0;"")" et je me retrouve avec la formule en texte dans Ws2.Range("C" & Rci.Row) alors que j'aurai voulu au mieux un "0".

Est ce que je peut écrire :

Code:

1
2
3
4
5
6
7
8
9
If Not Rci Is Nothing Then
        If Not Ws1.Cells(Lign, 5) = 3 Then
        If Not Ws1.Cells(Lign, 5) = "0" Then
            'Copie la plage
            Ws1.Cells(Lign, 5).Copy Destination:=Ws2.Range("C" & Rci.Row)
            Ws1.Cells(Lign, 7).Copy Destination:=Ws2.Range("E" & Rci.Row)
        End If
        End If
        End If

Tout cela me paraît douteux... En plus j'aurai toujours le problème de changement de MFC de ws2.

Si quelqu'un peut me conseiller je lui en serais reconnaissant. merci d'avance

07/03/2012, 16h36
Orhleil
Salut !
Si j'ai bien compris, tu souhaites copier le texte mais pas la mise en forme ?
Du coup :
Code:

1 2 Ws2.Range("C" & Rci.Row).Value = Ws1.Cells(Lign, 5).Value Ws2.Range("E" & Rci.Row).Value = Ws1.Cells(Lign, 7).Value
Ça ne répondrait pas à ton problème ? (ça fait longtemps que j'ai pas fait de VBA, j'ai un micro-doute sur le Value, sinon essaie Formula si ça s'adapte mieux à ton problème).

Je ne suis pas sûr de tout à fait comprendre le résultat que tu veux pour le deuxième problème, mais j'ai l'impression que tu pourras résoudre tout ça en jonglant entre Cells(X,Y).Value qui te renvoie le texte affiché dans la case (je crois), et Cells(X,Y).Formula qui te renvoie la formule qui détermine le texte qu'affichera la case.

Bonjour,

Tu peux remplacer

Code:

1
2
Ws1.Cells(Lign, 5).Copy Destination:=Ws2.Range("C" & Rci.Row)
Ws1.Cells(Lign, 7).Copy Destination:=Ws2.Range("E" & Rci.Row)

Par

Code:

1
2
3
4
5
Ws1.Cells(Lign, 5).Copy
Ws2.Range("C" & Rci.Row).PasteSpecial xlPasteValues
Cells(Lign, 7).Copy
Ws2.Range("E" & Rci.Row).PasteSpecial xlPasteValues
Application.CutCopyMode = False

Cordialement.