- Katılım
- 9 Eylül 2004
- Mesajlar
- 243
- Excel Vers. ve Dili
- Office2003Trk
arkadaşlar örnek ekdedir. ilgilenirseniz memnun olurum.
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub GÖSTER()
Application.ScreenUpdating = False
Set S1 = Sheets("VERİ")
Set S2 = Sheets("RAPOR")
Kriter1 = S2.[D5]
Kriter2 = S2.[F5]
S2.[B10:F65536].ClearContents
If Kriter1 = "" Or Kriter2 = "" Then
MsgBox "KAYIT GÖRÜNTÜLEMEK İÇİN EKSİK BİLGİ GİRDİNİZ. LÜTFEN KONTROL EDİNİZ.", vbCritical
[D5].Select
Exit Sub
End If
For X = 4 To S1.[A65536].End(3).Row
SATIR = S2.[B65536].End(3).Row
If Month(S1.Cells(X, 1)) = Kriter1 And Year(S1.Cells(X, 1)) = Kriter2 Then
S2.Cells(SATIR + 1, 2) = CDate(S1.Cells(X, 1))
S2.Cells(SATIR + 1, 3) = S1.Cells(X, 2)
S2.Cells(SATIR + 1, 4) = S1.Cells(X, 3)
S2.Cells(SATIR + 1, 5) = S1.Cells(X, 4)
S2.Cells(SATIR + 1, 6) = S1.Cells(X, 5)
End If
Next
[A1].Select
SAY = WorksheetFunction.CountA(S2.[B10:B65536])
If SAY = 0 Then
MsgBox "UYGUN KAYIT BULUNAMAMIŞTIR.", vbExclamation
Else
MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End If
Application.ScreenUpdating = True
End Sub