Calismayan Makro

[pelin5353]

Asagidaki makro Shared dosyada calistirmak istiyorum

Sub Print_Click()
On Error Resume Next
Application.ScreenUpdating = False

Set S1 = Sheets("Groups")
Set S2 = Sheets(2)
rtarih = InputBox("Yazdırılacak Rapor Tarihini Giriniz.Örnek 06.01.2007", "UYARI")
If rtarih = "" Then Exit Sub
[Y4] = CDate(rtarih)
Set alan1 = S1.Range("a4:S100")
Set alan2 = S1.Range("Y3:Y4")
Set alan3 = S1.Range("AA4:AS100")

alan3.ClearContents

alan1.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=alan2, CopyToRange:=alan3, Unique:=True

Set S1 = Nothing
Set S2 = Nothing
Set alan1 = Nothing
Set alan2 = Nothing
Set alan3 = Nothing

ActiveSheet.PageSetup.CenterHeader = [Y4] & " Tarihli Günlük Rapor"
ActiveWindow.SelectedSheets.PrintPreview
'ActiveSheet.PrintOut Copies:=1

Application.ScreenUpdating = True

End Sub