• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Otomatik Sayfa Oluşturma ve dosya yedekleme

A

arrow3441

Altın Üye
Katılım
31 Ekim 2022
Mesajlar
297
Excel Vers. ve Dili
2016
Merhaba hepinize iyi seneler diliyorum. Ekteki dosyada Veri sayfasında A2 hücresine ay başlangıç tarihi yazınca 1 aylık tarihleri alt alta yazması ve otomatik Şablon sayfasının kopyası alarak sayfaları oluşturması hücredeki tarihlere bakarak isimlendirmesi .Eğer aynı isme ait sayfalar varsa hiçbirşey yapmasın yada uyarsın
2. yapmak istediğim ise dosyayı hücrede tarihdeki aya bakarak isimlendirip yedekleyip sonra sayfaları silmesi Veri ve Şablon sayfası hariç olarak
 

Ekli dosyalar

Son düzenleme:
A2 hücresine
10.10.2022 yazınca

alt alta hangi tarihler oluşacak?
Limit nedir? Bugün mü? Yoksa 31 adet mavi renge sahip hücre var. A32 ye kadar. 31 adet tarih mi oluşacak?
 
31 adet tarih oluşucak hocam . Kaç gün çekiyorsa o ay ona göre oluşması gerekiyor. Ay başlangıcı yazıcam hocam 01.01.2023 gibi
 
Son düzenleme:
Aşağıdaki kodları boş bir modül içine kopyalayıp butonlarınıza atayabilirsiniz.
(Çalıştırmadan önce dosyanızın yedeğini alın)
C++: 
Sub TarihOnayla()
    Dim Sh1 As Worksheet, Sh2 As Worksheet, i As Integer
    Set Sh1 = Worksheets("Veri")
    Application.ScreenUpdating = False
    Sh1.Range("A3:B32").ClearContents
    If Sh1.Range("A2") = 0 Or Not IsDate(Sh1.Range("A2")) Then Exit Sub
    On Error Resume Next
    ReDim Liste(1 To 31)
    For i = 1 To 31
        Sh1.Range("A" & i + 1) = DateAdd("m", i - 1, Sh1.Range("A2"))
        Liste(i) = Format(Sh1.Range("A" & i + 1), "yyyy-mm")
        Set Sh2 = Worksheets(Liste(i))
        If Sh2 Is Nothing Then
            Worksheets("Şablon").Copy After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = Liste(i)
        End If
        Set Sh2 = Nothing
    Next i
    For i = 31 To 1 Step -1
        Worksheets(Liste(i)).Move After:=Worksheets("Şablon")
    Next i
    On Error GoTo 0
    Sh1.Activate
    Sh1.Range("A2").Activate
    Application.ScreenUpdating = True
    Set Sh1 = Nothing: Erase Liste: i = Empty
End Sub

Sub Yedekle()
    Dim Sh As Worksheet
    If WorksheetFunction.CountA(Range("A2:A32")) <> 31 Then MsgBox "A2:A32 arasında sayfa isimleri eksik": Exit Sub
    On Error Resume Next
    For i = 1 To 31
        Set Sh = Worksheets(Format(Range("A" & i + 1), "yyyy-mm"))
        If Sh Is Nothing Then MsgBox Format(Range("A" & i + 1), "yyyy-mm") & " Sayfası eksik": Exit Sub
        Set Sh = Nothing
    Next i
     If Sheets.Count > 33 Then MsgBox "Listediki 31 aydan daha fazla sayfa var": Exit Sub
    Application.DisplayAlerts = False
    Worksheets("Veri").Delete
    Worksheets("Şablon").Delete
    ThisWorkbook.SaveAs "YedekDosya-" & Format(Range("A2"), "yyyy-mm")
    On Error GoTo 0
    Application.DisplayAlerts = True
End Sub
 
Deneyip bilgi veriyorum hemen hocam çok teşekkür ederim
 
Hocam A2 01.01.2022 alttaki şekilde verdi . 02.01.2022,03.01.2022 şeklinde gitmesi gerekiyordu ama hocam birde şubat da 28 gün çekiyor ona göre oluşturması gerekiyor

01.02.2022

01.03.2022

01.04.2022

01.05.2022

01.06.2022

01.07.2022

01.08.2022

01.09.2022

01.10.2022

01.11.2022

01.12.2022

01.01.2023

01.02.2023

01.03.2023

01.04.2023

01.05.2023

01.06.2023

01.07.2023

01.08.2023

01.09.2023

01.10.2023

01.11.2023

01.12.2023

01.01.2024

01.02.2024

01.03.2024

01.04.2024

01.05.2024

01.06.2024

01.07.2024
 
Son düzenleme:
Merhaba Arkadaşım,
İnceleyiniz ... (Sanki biraz daha hızlı)
İyi çalışmalar
 

Ekli dosyalar

Hocam 2 dosyadaki kodlar aynı ama hız bakımından 2 side aynı gibi
 
İkinci dosya işlemleri göstermiyor. Sayfa çoğaltma işlemi daha fazla olsa aradaki farkı daha rahat görürdünüz.
Kolay gelsin
 
@arrow3441
Sayın Arrow3441,
Kusura bakma arkadaşım. Bu dosyaya bakın lütfen
İyi çalışmalar
 

Ekli dosyalar

Son düzenleme:
Evet hocam bu çok hızlı çok daha iyi elinize sağlık tekrardan
 
Yanlışlıkla aynı dosyayı tekrar göndermişim. Kusura bakma lütfen.
İyi çalışmalar
 
Hocam k.bakmayın lütfen birşeyi atlamışım oluşturulan sayfaların korunması gerekmektedir. Düzenleme yapabilirmsiniz buna göre
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst