Soru Yıllık İcmal Almak

[TURKOLOG]

Herkese Merhaba
Ekli dosyada İCMAL_2 sayfasında bulunan verileri macro ile Toplam başlığı altında topluyorum.

Benim yapamadığım :
Her yıl 15 Haziran tarihinden sonra
Excel ilk açılışında İCMAL_2 sayfası toplam başlığı altında olan verileri kopyalayıp YILLIK_İCMAL sayfasında örnekte gösterdiğim gibi 1. sütunlara başlık olarak içinde bulunduğu yılı yazarak altına İCMAL_2 de toplam başlığı altındaki verileri kopyalaması ve tablo yapması

Ben örnek olarak bir kaç yıl ekledim. Ama otomotik olarak içinde bulunduğu yılı 1. Satıra eklemesi gerekiyor. 2022 olunca kopyalamaya 2022 satırının altına 2023 olunca eski verilere dokunmadan 2023 altında toplam verileri kopyalacak.
Yardımcı olabilecek olan varsa çok sevinirim.

 

[muygun]

Merhaba;
Tam anladığımı söyleyemem ama yinede eki deneyin.
İyi çalışmalar.

 

[TURKOLOG]

Hocam ben anlatamadım.
Konuyu yeniden izah etmeye çalışayım.
her yıl 15 Hazirandan sonra dosya her açılışında YILLIK_İCMAL sayfasının b sütunundan başlamak üzere
içinde bulunduğumuz yıl 2021 .
O halde B1 de 2021 yazacak ve İCMAL_2 sayfamızın F2 F18 arasını kopyalayarak YILLIK_İCMAL sayfasına B2 B18 arasına kopyalayacak
içinde bulunduğumuz yıl 2022 .
O halde C1 de 2022 yazacak ve İCMAL_2 sayfamızın F2 F18 arasını kopyalayarak YILLIK_İCMAL sayfasına C2 C18 arasına kopyalayacak
içinde bulunduğumuz yıl 2023
O halde D1 de 2023 yazacak ve İCMAL_2 sayfamızın F2 F18 arasını kopyalayarak YILLIK_İCMAL sayfasına D2 D18 arasına kopyalayacak

Aşağıda bir şeyler yapmaya çalıştım ama takıldım olmadı yanı

Private Sub Workbook_Open()
Set vs = ThisWorkbook.Sheets("İCMAL_2")
If Date > DateValue("15/06/" & vs.[N1] + 1) Then vs.[N1] = Year(Date) - 1
If Date >= DateValue("15/06/" & vs.[N1]) And _
    Date <= DateValue("14/06/" & vs.[N1] + 1) Then
    İşlem Kodları gelse sonrasında vs.[N1] = vs.[N1] + 1
End If
End Sub

 

[Korhan Ayhan]

Deneyiniz.

Kodu ThisWorkbook ya da BuÇalışmaKitabı

Option Explicit

Private Sub Workbook_Open()
    Dim S1 As Worksheet, S2 As Worksheet, Bul As Range
    
    Set S1 = Sheets("İCMAL_2")
    Set S2 = Sheets("YILLIK_İCMAL")
    Set Bul = S2.Cells.Find(Year(Date), , , xlWhole)
    
    If Not Bul Is Nothing Then
        S1.Range("F2:F18").Copy
        Bul.Offset(1).PasteSpecial xlPasteValues
        Bul.Offset(1).PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
    Else
        With S2.Cells(1, S2.Columns.Count).End(1).Offset(, 1)
            .Value = Year(Date)
            S1.Range("F2:F18").Copy
            .Offset(1).PasteSpecial xlPasteValues
            .Offset(1).PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With
    End If

    Set S1 = Nothing
    Set S2 = Nothing
    Set Bul = Nothing
End Sub

 

[TURKOLOG]

Deneyiniz.

Kodu ThisWorkbook ya da BuÇalışmaKitabı

Option Explicit

Private Sub Workbook_Open()
    Dim S1 As Worksheet, S2 As Worksheet, Bul As Range
   
    Set S1 = Sheets("İCMAL_2")
    Set S2 = Sheets("YILLIK_İCMAL")
    Set Bul = S2.Cells.Find(Year(Date), , , xlWhole)
   
    If Not Bul Is Nothing Then
        S1.Range("F2:F18").Copy
        Bul.Offset(1).PasteSpecial xlPasteValues
        Bul.Offset(1).PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
    Else
        With S2.Cells(1, S2.Columns.Count).End(1).Offset(, 1)
            .Value = Year(Date)
            S1.Range("F2:F18").Copy
            .Offset(1).PasteSpecial xlPasteValues
            .Offset(1).PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With
    End If

    Set S1 = Nothing
    Set S2 = Nothing
    Set Bul = Nothing
End Sub

Sayın @Korhan Ayhan Hocam kafam karıştı.
Bu işlemi her yıl 15 Hazirandan sonra dosya ilk açıldığında 1 kere yapması gerekiyor.
Yine YILLIK_İCMAL Sayfasında 1. Satırlarda içinde bulunduğu yıl yoksa 1. satırdaki ilk boş satıra içinde bulunduğu yılı yazıp altına kopyalayıp tablo yapacak .

Zannımca bu hali ile her açılışta bu işlemi tekrarlıyor.

 

[Korhan Ayhan]

Doğrudur 15 Haziran detayını atladım. Sanırım onu da siz ekleyebilirsiniz.

 

[TURKOLOG]

Hocam aşağıdaki şekilde bi şeyler yazdım ama doğru mu bilemedim.

Option Explicit

Private Sub Workbook_Open()
    Dim S1 As Worksheet, S2 As Worksheet, Bul As Range
    Set S1 = Sheets("İCMAL_2")
    Set S2 = Sheets("YILLIK_İCMAL")
    Set Bul = S2.Cells.Find(Year(Date), , , xlWhole)
    

If Date > DateValue("15/06/" & S1.[N1] + 1) Then vs.[N1] = Year(Date) - 1
If Date >= DateValue("15/06/" & S1.[N1]) And _
    Date <= DateValue("14/06/" & S1.[N1] + 1) Then
    
If Not Bul Is Nothing Then
        S1.Range("F2:F18").Copy
        Bul.Offset(1).PasteSpecial xlPasteValues
        Bul.Offset(1).PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
    Else
        With S2.Cells(1, S2.Columns.Count).End(1).Offset(, 1)
            .Value = Year(Date)
            S1.Range("F2:F18").Copy
            .Offset(1).PasteSpecial xlPasteValues
            .Offset(1).PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With
    

 S1.[N1] = S1.[N1] + 1
End If
    Set S1 = Nothing
    Set S2 = Nothing
    Set Bul = Nothing

 

[Korhan Ayhan]

Sanki IF bloğu kapanmamış (End If) gibi görünüyor. Eklediğiniz sorgu satırınız doğruysa sorun yoktur.

 

[TURKOLOG]

Hocam çok teşekkür ederim . Kod çalıştı. Elinize emeğinize sağlık.