Copier une cellule avec son format
Bonjour
J'ai adapté une macro pour une nouvelle utilisation. Cette macro consiste à partir d'une liste de numéros ayant chacun un créneau horaire, d'établir des listes pour chaque créneau. Cette macro fonctionne mais je n'arriva pas à copier le numéro avec son format, sa couleur de cellule. je ne copie que la valeur. Est-ce que quelqu'un peur m'aider. D'avance merci. ci-dessous la macro
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
| Sub compiler()
Dim i As Integer
Range("compteur").Value = 2
Sheets("Liste").Select
Range("B3:W38").Select
Selection.ClearContents
Range("A2").Select
Sheets("Bénéficiaires").Select
For Each cel In Range("cren")
If IsNumeric(cel.Value) Then
If cel.Value >= 1 Then
i = cel.Value
Sheets("Liste").Cells(1, i + 1).Value = Sheets("Liste").Cells(1, i + 1).Value + 1
j = Sheets("Liste").Cells(1, i + 1).Value
Sheets("Liste").Cells(j, i + 1).Value = Cells(cel.Row, 1).Value
End If
End If
Next
End Sub |
Merci beaucoup pour votre réactivité et pour la justesse de votre correction
Citation:
Envoyé par
Menhir
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
| Sub compiler()
Dim i As Integer
Range("compteur").Value = 2
Sheets("Liste").Range("B3:W38").ClearContents
For Each cel In Sheets("Bénéficiaires").Range("cren")
If IsNumeric(cel.Value) Then
If cel.Value >= 1 Then
i = cel.Value + 1
Sheets("Liste").Cells(1, i).Value = Sheets("Liste").Cells(1, i).Value + 1
j = Sheets("Liste").Cells(1, i).Value
Sheets("Bénéficiaires").Cells(cel.Row, 1).Copy Sheets("Liste").Cells(j, i)
End If
End If
Next
End Sub |
Je n'ai pas testé. Il y aura donc peut-être du débugage à faire.