Bagcivan
Altın Üye
- Katılım
- 7 Ağustos 2008
- Mesajlar
- 193
- Excel Vers. ve Dili
- office 2019 türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Düğme1_Tıklat()
Dim i As Integer
Dim sh As Worksheet
Dim sh_master As Worksheet
Dim sn As Long
Set sh = Sheets("anasayfa")
Set sh_master = Sheets("ornek")
sn = sh.Range("b65536").End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To sn
If Not sh_kontrol(Format(sh.Cells(i, "b"), "dd.mm")) Then
sh_master.Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).[t1] = Format(sh.Cells(i, "b"), "dd.mm.yyyy")
Sheets(Sheets.Count).Name = CStr(Format(sh.Cells(i, "b"), "dd.mm"))
End If
Next i
Application.ScreenUpdating = True
Set sh = Nothing: Set sh_master = Nothing
End Sub