Copie de cellule + mise en forme

[Fanoo]

Bonjour le forum,

Pour mon application je souhaite trouver une cellule fusionnée dans une colonne en la distinguant par sa valeur pour la copier dans une autre colonne en gardant la mise en forme et la valeur de cette cellule.

J'ai consulté le forum et j'ai essayé pas mal de chose mais sans réussite..

Merci d'avance pour votre aide!

 

[jpb388]

Re : Copie de cellule + mise en forme

Bonjour à tous
essayes cela dans un module

Sub Recherche()

Dim réponse, cel As Range

réponse = InputBox("num recherche")
For Each cel In Range("a1:a" & Range("a" & Rows.Count).End(xlUp).Row)
If cel.Text = réponse Then
    Range(Cells(cel.Row, cel.Column), Cells(cel.Row, cel.Column + 1)).Copy
    Range("e3").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
End If
Next
End Sub

 

[Fanoo]

Re : Copie de cellule + mise en forme

Bonjour le forum et jpb388,

Tout d'abord merci à toi de t'être penché sur le sujet.

J'ai essayé ton code et il fonctionne à l'exception près qu'il ne garde pas la mise en forme de la cellule fusionnée. Pour la couleur, bordure,valeur c'est ok mais il ne copie ça que dans une seul cellule sauf que moi je souhaite que la cellule fusionnée soit recopier sur le même nombre de cellule.
ex: J'ai une cellule fusionnée sur cinq lignes je veux que la copie soit aussi sur 5 ligne mais d'une autre colonne donc que la copie garde exactement la même mise en forme...

Mais je ne sais pas si c'est possible étant donné les commentaires sur l'inconvénient des cellule fusionnées...

Du coup pour le moment je fais exactement comme le code que tu m'a proposé et ensuite je redimensionne la cellule et la fusionne dans mon code, mais j'aimerais vraiment trouvé une autre solution...

Si vous avez des idées n'hésitez pas!

 

[Fanoo]

Re : Copie de cellule + mise en forme

Oups je crois que j'ai parler un peu vite...

J'ai remarquer en utilisant ton code et en l'adaptant un peu qu'en faite la mise en forme donc la fusion des cellules est bien conservée!!

Donc un grand Merci à toi!!

 

[jpb388]

Re : Copie de cellule + mise en forme

Bonjour
pour le cas où
voici la rectif

Sub Recherche()

 Dim réponse, cel As Range

 réponse = InputBox("num recherche")
 For Each cel In Range("a1:a" & Range("a" & Rows.Count).End(xlUp).Row)
 If cel.Text = réponse Then
     Range(Cells(cel.Row, cel.Column), Cells(cel.Row, cel.Column + 1)).Copy
     Range("e3").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
         , SkipBlanks:=False, Transpose:=False
    Range("e3:f3").Merge
End If
 Next
 End Sub