Biçimleri ile Birlikte Bilgi Getirme

[mrs303]

Selamlar,

Ekteki dosyada açıklamasını yaptığım veri alanında biçimleri ile birlikte bilgileri tabloya aktarmak istedim fakat nekadar uğraştıysam başaramadım. Biçimler olmadan bilgiler getirilebiliyor , fakat ben hücrenin tüm biçimleri(renkleri) ile birlikte verilen kritere göre tabloda yer almasını istiyorum.

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

Sub Duzenle()
Dim i As Long
Dim j As Integer
 
Application.ScreenUpdating = False
Range("G3:I65500").Clear
 
For i = 3 To Cells(Rows.Count, "D").End(3).Row
    If Cells(i, "D") < 50 Then
        j = 7
    ElseIf Cells(i, "D") < 61 Then
        j = 8
    Else
        j = 9
    End If
 
    Cells(i, "D").Copy Cells(Cells(Rows.Count, j).End(3).Row + 1, j)
 
Next i
Application.ScreenUpdating = True
End Sub

 

[mrs303]

Sn Necdet Bey,

Tam istediğim şekilde olmuş, çok pratik ve hızlı çalışıyor. Çok teşekkür ederim.
Emeğinize sağlık.