Yıl Sonu Cari Kapama ve Açma

[htsumer]

Ekteki dosyada "RAPORLAR" sayfasından "rapor_al_YENİSİ" makrosu ile cari kartların ilgili yerlerinden rapor alıyorum. Bu raporlama sonucu carilerin Bakiyeleri geliyor. Örnektede vardır.

Yıl Sonu İşlemi için;
Yapmaya çalıştığım şöyle,

*Önce makro "rapor_al_YENİSİ" makrosunu garanti olsun diye çalıştıracak.

Sub yil_sonu ()
rapor_al_YENİSİ
....
...
..
.

*Raporlama güncellendi.
*"RAPORLAR" Sayfasının B3 (İsim) Hücresindeki ismi, "ŞABLON" sayfasının B1 (Müşteri Adı Soyadı) Hücresine alacak
*"RAPORLAR" Sayfasının D3 (Aylık Muhasebe) Hücresindeki Ücreti, "ŞABLON" sayfasının F2 (Aylık Muhasebe) Hücresine alacak,
*"RAPORLAR" Sayfasının H3 (Bakiye) Hücresindeki miktarını, "ŞABLON" sayfasının D10 (2018 KALAN BAKİYE) Hücresine alacak,
*Aktarma işlemi sonunda bu "ŞABLON" Sayfasının B1 Hücresindeki İsim İle Yeni Sayfa olarak açacak.(Var olan aynı sayfalar silinecek yada ..(2) olarak açılacak.)

Bu süreç RAPORLA sayfasındaki tüm isimler bitene kadar devam edecek.

Elimde şu kod var ama bunu uyarlayamadım.. (SAYFALARI_OLUŞTUR)

Sub SAYFALARI_OLUŞTUR()
' sayfa oluşturuken zaman eklendi eklemek kısa sürüyor üstteki ilk hali
    Dim S1 As Worksheet, S2 As Worksheet
    Dim S3 As Worksheet, x As Long, Son As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    zaman = Timer
    Set S1 = Sheets("ANA MENÜ")
    Set S2 = Sheets("ŞABLON")
    
    Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
    
    For x = 2 To Son
        Set S3 = Nothing
        On Error Resume Next
        Set S3 = Sheets(S1.Cells(x, 2).Value)
        On Error GoTo 0
        
        If S3 Is Nothing Then
            S2.Copy , Sheets(ThisWorkbook.Worksheets.Count)
            ActiveSheet.Name = S1.Cells(x, 2).Value
            Range("B1") = ActiveSheet.Name
            S1.Select
        End If
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
MsgBox [A1] & " TAMAMLANMIŞTIR." & vbLf & vbLf & _
    "İşlem süresi: " & Format(Timer - zaman, "0.0") & " saniye.", vbInformation
PopUpMenu
'    MsgBox "Sayfalar oluşturulmuştur.", vbInformation
End Sub

 

[htsumer]

Güncel.....