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.

---

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ı yani

    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  

Merhaba.Kodu deneyiniz.

Sub kopyala()

Dim sonSut As Integer, tar As Range, son As Long



With Sheets("YILLIK_ÝCMAL")

    sonSut = .Cells(1, Columns.Count).End(xlToLeft).Column

    If sonSut < 2 Then Exit Sub

    son = Sheets("ÝCMAL_2").Cells(Rows.Count, 1).End(3).Row

    For Each tar In .Range(.Cells(1, 2), .Cells(1, sonSut))

        If tar.Value = Year(Date) Then

            Sheets("ÝCMAL_2").Range("A2:A" & son).Copy .Cells(2, 1)

            Sheets("ÝCMAL_2").Range("F2:F" & son).Copy .Cells(2, tar.Column)

            Exit For

        End If

    Next

End With

Application.CutCopyMode = False

Set tar = Nothing

MsgBox "Bitti"

End Sub

(09/05/2021, 00:37)feraz yazdı: Merhaba.Kodu deneyiniz.

Sub kopyala()

Dim sonSut As Integer, tar As Range, son As Long



With Sheets("YILLIK_ÝCMAL")

    sonSut = .Cells(1, Columns.Count).End(xlToLeft).Column

    If sonSut < 2 Then Exit Sub

    son = Sheets("ÝCMAL_2").Cells(Rows.Count, 1).End(3).Row

    For Each tar In .Range(.Cells(1, 2), .Cells(1, sonSut))

        If tar.Value = Year(Date) Then

            Sheets("ÝCMAL_2").Range("A2:A" & son).Copy .Cells(2, 1)

            Sheets("ÝCMAL_2").Range("F2:F" & son).Copy .Cells(2, tar.Column)

            Exit For

        End If

    Next

End With

Application.CutCopyMode = False

Set tar = Nothing

MsgBox "Bitti"

End Sub

Zafer 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 .

(09/05/2021, 03:42)hayalibey yazdı: Bu işlemi her yıl 15 Hazirandan sonra dosya ilk açıldığında 1 kere yapması gerekiyor.

Ben kodu çalıştırınca eklettim.O kısmı görmemişim.15 hazirandan sonra sonra kod çalıştırmasını yaparızda 1 defa nasıl çalıştırılır onu bilmiyorum.Belki bir sayfa ekleyip bir hücresine 1 kere çalışınca 1 yazdırılıp bir dahaki seneyi bekletilebilinir yoksa zor ihtimal abey bence.Kodu ayarlarsam eklerim bugün.

(09/05/2021, 11:43)feraz yazdı:

(09/05/2021, 03:42)hayalibey yazdı: Bu işlemi her yıl 15 Hazirandan sonra dosya ilk açıldığında 1 kere yapması gerekiyor.

Ben kodu çalıştırınca eklettim.O kısmı görmemişim.15 hazirandan sonra sonra kod çalıştırmasını yaparızda 1 defa naıl çalıştırılır onu bilmiyorum.Belki bir sayfa ekleyip bir hücresine 1 kere çalışınca 1 yazdırılıp bir dahaki seneyi bekletilebilinir yoksa zor ihtimal abey bence.Kodu ayarlarsam eklerim bugün.

Hocam aşağıdaki kodu revize etsek
Misal icmal_2 sayfası n1 hücresine 2020 yazsak
Her yıl 15 haziranda açılınca yılı 1 arttırsa

(09/05/2021, 12:06)hayalibey yazdı:

(09/05/2021, 11:43)feraz yazdı:

(09/05/2021, 03:42)hayalibey yazdı: Bu işlemi her yıl 15 Hazirandan sonra dosya ilk açıldığında 1 kere yapması gerekiyor.

Ben kodu çalıştırınca eklettim.O kısmı görmemişim.15 hazirandan sonra sonra kod çalıştırmasını yaparızda 1 defa naıl çalıştırılır onu bilmiyorum.Belki bir sayfa ekleyip bir hücresine 1 kere çalışınca 1 yazdırılıp bir dahaki seneyi bekletilebilinir yoksa zor ihtimal abey bence.Kodu ayarlarsam eklerim bugün.

Hocam aşağıdaki kodu revize etsek
Misal icmal_2 sayfası n1 hücresine 2020 yazsak
Her yıl 15 haziranda açılınca yılı 1 arttırsa

Kod:

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

Visual Basic Code
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

O koda gerek kalmadan ayarlayacağım Allah'ın izniyle abey