chercher données et coller en rouge

J

jean

Guest
Bojour a vous tous

on ma donné cette macro il y quelques jours,elle fonctione tres bien!
cependant je ne parvient pas a faire une petite modif.
je voudrais que mes resultats ce collent en rouge...
merci

Sub SelectionCopier26()
Dim X, Y, Z As Integer
Dim MaLigne As Integer
Application.ScreenUpdating = False
Workbooks.Open Filename:='c:\\Basededonnée2(carbone).xls'
Windows('Basededonnée2(carbone).xls').Activate
For X = 1 To Worksheets('26C').Cells(65536, 3).End(xlUp).Row
Select Case Worksheets('26C').Cells(X, 3)
Case '60E2132'
MaLigne = 799
Case '60E2134'
MaLigne = 1299
Case '60E2135'
MaLigne = 1799
Case '60E2206'
MaLigne = 2299
Case '60E2423'
MaLigne = 2799
Case '60E2424'
MaLigne = 3299
Case '60E2425'
MaLigne = 3799
Case '60E2124'
MaLigne = 4299
Case '60E2105'
MaLigne = 4799
Case '60E2106'
MaLigne = 5299
Case '60E2107'
MaLigne = 5799
Case '60E2108'
MaLigne = 6299
Case '60E2122'
MaLigne = 6799
Case '60E2112'
MaLigne = 7299
Case '60E2109'
MaLigne = 7799
Case Else
MaLigne = 0
End Select
If MaLigne <> 0 Then
Z = Workbooks('Essai Logiciel suivi des coûts(carbone).xls').Worksheets('semaine 26').Range('A' & MaLigne).End(xlUp).Row + 1
For Y = 1 To 16
Workbooks('Essai Logiciel suivi des coûts(carbone).xls').Worksheets('semaine 26').Cells(Z, Y) = Worksheets('26C').Cells(X, Y)
Next
End If
Next
ActiveWorkbook.Close False

Application.ScreenUpdating = True
End Sub
 

Statistiques des forums

Discussions
312 303
Messages
2 087 047
Membres
103 441
dernier inscrit
MarioC