Günlük Sayfa yazdırma

[Cibali]

Merhaba,
2007 de çalışan kod 2013 de çalışmıyor,
yardım lütfen


Private Sub Worksheet_Activate()
Dim s1 As Worksheet
Dim b, d As Long
Dim a As String
Dim c
Application.Calculation = xlCalculationManual
[A:E] = Empty
On Error Resume Next
a = DatePart("d", Date)
Set s1 = Sheets(a)
If s1 Is Nothing Then MsgBox "SAYFA BULUNAMADI": GoTo çık
If s1.Name <> ActiveSheet.Name Then
b = s1.Cells(Rows.Count, "A").End(3).Row
For Each c In s1.Range("B5:B" & b & "," & "M5:M" & b).SpecialCells(xlCellTypeConstants, 23).Cells
d = ActiveSheet.Cells(Rows.Count, "A").End(3).Row + 1
If c.Column = 2 Then
If Application.Sum(s1.Range("D" & c.Row & ":E" & c.Row)) <> 0 Then
Cells(d, "a") = c.Value
Range("B" & d) = Application.Sum(s1.Range("D" & c.Row & ":E" & c.Row))
Range("C" & d).Value = s1.Range("F" & c.Row).Value
End If
Else
If Application.Sum(s1.Range("N" & c.Row & ":O" & c.Row)) <> 0 Then
Cells(d, "a") = c.Value
Range("D" & d) = Application.Sum(s1.Range("N" & c.Row & ":O" & c.Row))
Range("E" & d).Value = s1.Range("P" & c.Row).Value
End If
End If
Next
End If
çık:
Application.Calculation = xlCalculationAutomatic
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

 

[PLİNT]

Merhaba
_Kodlar içinden "On Error Resume Next" bölümünü kaldırıp hata veriyormu bir bakın
sayı değerleri için kodlar içinde "23" yerine "1" yazıp denedinizmi?
_.SpecialCells(xlCellTypeConstants, 23).Cells

 

[Cibali]

"On Error Resume Next" kaldırınca 1004 hata hücre bulunamadı hatası
ayrıca bu bölge sarı oluyor
For Each c In s1.Range("B5:B" & b & "," & "M5:M" & b).SpecialCells(xlCellTypeConstants, 1).Cells

.SpecialCells(xlCellTypeConstants, 23).Cells 1 olduğunda değişen birşey yok

 

[PLİNT]

"b" tanımlaması 5 ten küçük olmamalı ve bu aralıkta sayısal değer mevcut olmalıdırki hücre bulabilsin.
"s1.Range("B5:B" & b & "," & "M5:M" & b).SpecialCells(xlCellTypeConstants, 1).Cells"

"A" sütununda dolu (hücre) satır sayısı 5 den küçük olabilir
şurada "a" yerine "b" (dolu hücre 5 satırdan büyükse) yazarak deneyin.
"b = s1.Cells(Rows.Count, "A").End(3).Row"

 

[PLİNT]

Merhaba
Sizin başka konudaki dosyanıza baktım; aynı dosya ile ilgili ise;
Kodlar içindeki ilgili bölümü; aşağıda kırmızı ile değiştirip deneyin.
Başka dosya ise örnek eklersiniz.

[SIZE="2"] For Each c In s1.Range("B5:B" & b & "," & "M5:M" & b).SpecialCells([COLOR="Red"]xlCellTypeFormulas[/COLOR], 23).Cells[/SIZE]

 

[Cibali]

Teşekkür ederim hocam, hallettim. Çok sağolun.