DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub deneme()
Dim hücre As Range, Son_Satır As Long
Application.ScreenUpdating = False
For Each hücre In Range("H2:H" & Range("H65536").End(3).Row)
If CDate(hücre) >= CDate("12.08.2008") And CDate(hücre) <= CDate("17.05.2010") _
And Cells(hücre.Row, "J") = "a" Then
With Sheets("Sayfa1")
Son_Satır = .Range("A65536").End(3).Row + 1
.Cells(Son_Satır, "A") = Son_Satır - 1
Range(Cells(hücre.Row, "B"), Cells(hücre.Row, "K")).Copy
.Cells(Son_Satır, "B").PasteSpecial xlValues
End With
End If
Next
MsgBox "İşleminiz tamamlanmıştır", vbInformation, "Sn. " & Application.UserName
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Submerhaba
#2 nolu mesajımı yeniledim ve dosyanızı ekledim eki inceleyiniz.
Aynı hatayı alıyorum hocam...
Peki hata ile ilgili bir araştırma yaptınız mı ? Yani bir değişken var ondan mı alıyorsunuz yoksa makro güvenliğiniz en yüksek seviyede ondan mı alıyorsunuz ? Sitede bir çok hata ile ilgili problemler çözümlenmiştir. Mesela
Peki siz bu kodu çalıştırırken SAYFA yazılı çalışma sayfanın içerisindesiniz dimi? Diğer sayfa da kodu çalıştırdığımda ben de de aynı hata verdi o yüzden soruyorum.
Option Explicit
Sub deneme()
Dim hücre As Range, Son_Satır As Long
Dim S1 As Worksheet, S2 As Worksheet
Application.ScreenUpdating = False
Set S1 = Sheets("SAYFA")
Set S2 = Sheets("SAYFA1")
For Each hücre In S1.Range("H2:H" & S1.Range("H65536").End(3).Row)
If CDate(hücre) >= CDate("12.08.2008") And CDate(hücre) <= CDate("17.05.2010") _
And S1.Cells(hücre.Row, "J") = "a" Then
Son_Satır = S2.Range("A65536").End(3).Row + 1
S2.Cells(Son_Satır, "A") = Son_Satır - 1
S2.Cells(Son_Satır, "B") = S1.Cells(hücre.Row, "B")
S2.Cells(Son_Satır, "C") = S1.Cells(hücre.Row, "C")
S2.Cells(Son_Satır, "D") = S1.Cells(hücre.Row, "D")
S2.Cells(Son_Satır, "E") = S1.Cells(hücre.Row, "E")
S2.Cells(Son_Satır, "F") = S1.Cells(hücre.Row, "F")
S2.Cells(Son_Satır, "G") = S1.Cells(hücre.Row, "G")
S2.Cells(Son_Satır, "H") = S1.Cells(hücre.Row, "H")
S2.Cells(Son_Satır, "I") = S1.Cells(hücre.Row, "I")
S2.Cells(Son_Satır, "J") = S1.Cells(hücre.Row, "J")
S2.Cells(Son_Satır, "K") = S1.Cells(hücre.Row, "K")
End If
Next
MsgBox "İşleminiz tamamlanmıştır", vbInformation, "Sn. " & Application.UserName
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub