koşullu biçimlendirme ve tek bir sayfada toplama

[cemxcx]

c<szczdvzvc zsvzxv s

 

[Orion1]

Örnek bir dosya yollamanız ve örnek dosyada açıklayıcı bilgiler vermeniz sorunuza cevap almanızı hızlandıracaktır.

 

[Orion1]

Merhaba.
Bir tane RAPOR sayfas&#305; olu&#351;turdum.
O sayfada butona basarak rapor alabilirsiniz.
Ayr&#305;ca amortis&#246;r imalat&#305; sayfas&#305;na ko&#351;ullu biimlendirme yapt&#305;m di&#287;er syfslar&#305;n ko&#351;ullu bi&#231;imlendirmelerini size b&#305;rakt&#305;m.
Ekli dosyay&#305; inceleyiniz.
Dosyay&#305; g&#252;ncelledim.

Sub rapor()
Dim syf As Worksheet, tarih As Date
Sheets("RAPOR").Select
Range("A3:I65536").ClearContents
sat = 3
Application.ScreenUpdating = False
For Each syf In Worksheets
If syf.Name <> "RAPOR" Then
sonsat = Sheets(syf.Name).Cells(65536, "E").End(xlUp).Row
If sonsat >= 3 Then
    For i = 3 To sonsat
        tarih = Sheets(syf.Name).Cells(i, "E").Value
        If tarih - Date <= 2 Then
            adrR = Range(Cells(sat, "A"), Cells(sat, "I")).Address
            adr2 = Range(Cells(i, "A"), Cells(i, "I")).Address
            Sheets("RAPOR").Range(adrR).Value = Sheets(syf.Name).Range(adr2).Value
            sat = sat + 1
        End If
    Next i
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "RAPOR &#199;IKARILDI..!!"
End Sub

 

[cemxcx]

bu çalışmıyo hata veriyor

 

[Orion1]

&#214;zel mesajdan belirti&#287;iniz &#351;ekilde dosyay&#305; g&#252;nceledim.
&#214;nceki mesaj&#305;mdan indirebilirsiniz.