Çalışmıyor

[Cibali]

Merhaba,

2007 de bu kodlarım çalışıyordu, gün bazında sayfadaki verileri sıralıyordu.
2013 ü kurdum fakat şimdi çalışmıyor,
Nasıl aktif hael getirebilirim,
Teşekkürler...


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

 

[numan şamil]

Merhaba
Yeni boş excel sayfası Aç
Dosya/Güvenlik Merkezi/Güvenlik Merkezi Ayarları/Makro Ayarları
Açılan Pencereden
Tüm Makroları etkinleştir işaretle
Tamam
Exceli kapat
Ayrıca kodlar sonundaki

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Bu şekliyle bir işe yarıyor mu?

 

[Cibali]

yok hocam, yine çalışmadı.

 

[numan şamil]

Merhaba

On Error Resume Next

kodunuzu

'On Error Resume Next

Şeklinde değiştirip dener misiniz
Bakalım hata alacak mısınız?

 

[Cibali]

hata 1004 verdi hocam

 

[numan şamil]

Kodlarda nereyi sarıya boyadı?

 

[Cibali]

For Each c In s1.Range("B5:B" & b & "," & "M5:M" & b).SpecialCells(xlCellTypeConstants, 23).Cells


bu kısmı sarıya boyadı

 

[numan şamil]

Merhaba
2. Mesajımda belirttiğim yolu izleyin ve en son çıkan pencerede

Visual Basic projesine güven seçeneğini işaretleyin(kutucuğa tik koyun)
Ve tamam tıklayın

 

[Cibali]

Söylediğiniz şekilde yaptım ama sonuç yine aynı

run time 1004
Hiç bir hücre bulunamadı diyor

 

[numan şamil]

Dosyanızı veya örnek bir dosya ekleyebilirmisiniz

 

[Cibali]

buyrun hocam

http://s9.dosya.tc/server2/usxjmq/Bilet_04-17.rar.html

 

[Cibali]

Cevap veremezsenm bugün özür dilerim,

Yardımlarınız için teşekkürler

Ofis 2013 olarak çalışması gerekiyor

 

[numan şamil]

Sayfa isimlerinde bir değişiklik olmadığına emin misiniz?

a = DatePart("d", Date)
Set s1 = Sheets(a)

 

[numan şamil]

Eminim Ofis 2013 kullanan arkadaşlar deneyip yardımcı olacaklardır

 

[Cibali]

Sayfa ismi değiştiğinde Sayfa bulunamadı ikazı geliyor