Kapalı dosyaya yazdırma - Muhasebe tediye

[mars2]

İyi Günler;

Ramazan bayramı hayırlara, sağlığa ve huzurlu günlere vesile olmasını dilerim.
Ekli dosya ile aylık olarak muhasebe tesiye işlemleri yapılmaktadır. aşağidaki kodla aynı excel çalışma kitabına hesap koduna göre sayfa açıp ve kaydediyor.
Ancak, muhasebe tediyenin bulunduğu klasörde hesap kodlarına ait kayıtların ayrı çalışma kitabında (2022) her kod için ayrı bir sayfa açılması veya açılmış ise kayıt edilmesini istemekteyim. Bu konuda yardımlarınız beklemekteyim.



If Target = "" Then Exit Sub
son = WorksheetFunction.Max(Cells(Rows.Count, "A").End(3).Row, Cells(Rows.Count, "B").End(3).Row) + 1
sayfalar = Sheets.Count
dönem = ActiveSheet.Name
a = Target.Row
If Intersect(Target, Range("A2:B" & son)) Is Nothing Then GoTo 10
For i = 1 To sayfalar
If Sheets(i).Name & "a" = Target & "a" Then
kod = "Var"
End If
Next
If kod <> "Var" Then
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = Target
ActiveSheet.[A1] = "Tarih"
ActiveSheet.[B1] = "İzahat"
ActiveSheet.[C1] = "Borç TL"
ActiveSheet.[D1] = "Alacak TL"
ActiveSheet.[A11].Borders.LineStyle = xlContinuous
ActiveSheet.[A11].Font.Bold = True
ActiveSheet.[A11].HorizontalAlignment = xlCenter
ActiveSheet.[A11].VerticalAlignment = xlCenter
End If
Sheets(dönem).Activate
10:
If Intersect(Target, Range("E2:F" & son)) Is Nothing Then Exit Sub
If Target.Offset(0, -4) = "" Then
MsgBox "Lütfen önce " & Target.Offset(-(a - 1), -4) & "nu giriniz", vbCritical
Application.EnableEvents = False
Target = ""
Application.EnableEvents = True
Exit Sub
End If

For i = 1 To sayfalar
If Cells(a, "A") <> "" Then
If Sheets(i).Name & "a" = Cells(a, "A") & "a" Then
kod = "Var"
End If
Else
If Sheets(i).Name & "a" = Cells(a, "B") & "a" Then
kod = "Var"
End If
End If
Next

If kod <> "Var" Then
Sheets.Add After:=ActiveSheet
If Cells(a, "A") <> "" Then
ActiveSheet.Name = Cells(a, "A")
Else
ActiveSheet.Name = Cells(a, "B")
End If

ActiveSheet.[A1] = "Tarih"
ActiveSheet.[B1] = "İzahat"
ActiveSheet.[C1] = "Borç TL"
ActiveSheet.[D1] = "Alacak TL"
ActiveSheet.[A12].Borders.LineStyle = xlContinuous
ActiveSheet.[A11].Font.Bold = True
ActiveSheet.[A11].HorizontalAlignment = xlCenter
ActiveSheet.[A11].VerticalAlignment = xlCenter
ActiveSheet.[C2] = Cells(a, "E")
ActiveSheet.[D2] = Cells(a, "F")
ActiveSheet.[C2200].NumberFormat = "#,##0.00 $"

Else
For i = 1 To sayfalar
If Cells(a, "A") <> "" Then
If Sheets(i).Name & "a" = Cells(a, "A") & "a" Then
yeni = Sheets(i).Cells(Rows.Count, "A").End(3).Row + 1
Sheets(i).Cells(yeni, "A") = Date
Sheets(i).Cells(yeni, "A").NumberFormat = "dd/mm/yyyy"
Sheets(i).Cells(yeni, "B") = Cells(a, "C")
Sheets(i).Cells(yeni, "C") = Cells(a, "E")
Sheets(i).Cells(yeni, "D") = Cells(a, "F")
Sheets(i).Cells(yeni, "C").NumberFormat = "#,##0.00 $"
Sheets(i).Cells(yeni, "D").NumberFormat = "#,##0.00 $"
Sheets(i).Range("A" & yeni & "" & yeni).Borders.LineStyle = xlContinuous
End If
Else
If Sheets(i).Name & "a" = Cells(a, "B") & "a" Then
yeni = Sheets(i).Cells(Rows.Count, "A").End(3).Row + 1
Sheets(i).Cells(yeni, "A") = Date
Sheets(i).Cells(yeni, "A").NumberFormat = "dd/mm/yyyy"
Sheets(i).Cells(yeni, "B") = Cells(a, "C")
Sheets(i).Cells(yeni, "C") = Cells(a, "E")
Sheets(i).Cells(yeni, "D") = Cells(a, "F")
Sheets(i).Cells(yeni, "C").NumberFormat = "#,##0.00 $"
Sheets(i).Cells(yeni, "D").NumberFormat = "#,##0.00 $"
Sheets(i).Range("A" & yeni & "" & yeni).Borders.LineStyle = xlContinuous
End If
End If
Next
End If

Sheets(dönem).Activate

 

[mars2]

İyi Günler;
Konu hakkında yardımlarınız beklenmektedir.