Soru Hesap Koduna göre yeni sayfa açıp kayıt etme?

mars2

Altın Üye
Katılım
2 Eylül 2004
Mesajlar
570
Excel Vers. ve Dili
2016 - Türkçe
2019 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2026
İyi Günler;
Muhasebe kaydı için daha önceden hazırladığım ve geliştirmeye çalıştığım formun A sutunu veya B sutunundaki hesap kodu yazdığımda;
1- bu koda göre sayfa açılmamış ise sayfa açıyor, ancak, açılan sayfanın B1 hücresine hesap kodu, B2 hücresine hesap adını yazdırmak, 5. satırdan itibaren kayıt yaptırmak
2- hesap kodu ile açılan sayfanın A4 sutununda Sıra No, B4 sutununda tarih, C4 sutununda açıklama, D4 sutunda ise borçlu tutar, E4 sutunda ise alacak tutarı yazısı bulunmaktadır. 5. satırdan itibaren aylardaki hesap kodlarına göre yapılan kayıtları aktarmnak istiyorum.
3- Aşağıdaki makro ile daha önceden kod sayfasına A sutununa Sıra No sutunu ekmeden önce yapmakta idi ancak, A sutuna Sıra No ekleyince ve makroda düzeltmeye çalışmama rağmen kayıt etmemektedir. sorunun kaynağı nerededir ve nasıl çözebiliriz.
4- Ayrıca, her ay kayıtlardan sonra bir seferde aktarmak için makroda ne gi ibi değişiklik yapmak gereklidir.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

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.[A4] = "Sıra"
ActiveSheet.[B4] = "Tarih"
ActiveSheet.[C4] = "İzahat"
ActiveSheet.[D4] = "Borç TL"
ActiveSheet.[E4] = "Alacak TL"

ActiveSheet.[A4:E4].Borders.LineStyle = xlContinuous
ActiveSheet.[A4:E4].Font.Bold = True
ActiveSheet.[A4:E4].HorizontalAlignment = xlCenter
ActiveSheet.[A4:E4].VerticalAlignment = xlCenter
End If
Sheets(dönem).Activate
10:
If Intersect(Target, Range("F5:G" & son)) Is Nothing Then Exit Sub
If Target.Offset(0, -5) = "" Then
MsgBox "Lütfen önce " & Target.Offset(-(a - 1), -5) & "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" 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.[A4] = "Sıra No"
ActiveSheet.[B4] = "Tarih"
ActiveSheet.[C4] = "İzahat"
ActiveSheet.[D4] = "Borç TL"
ActiveSheet.[E4] = "Alacak TL"

ActiveSheet.[A4:E4].Borders.LineStyle = xlContinuous
ActiveSheet.[A4:E4].Font.Bold = True
ActiveSheet.[A4:E4].HorizontalAlignment = xlCenter
ActiveSheet.[A4:E4].VerticalAlignment = xlCenter


ActiveSheet.[B5] = Cells(a, "D")
ActiveSheet.[C5] = Cells(a, "E")
ActiveSheet.[D5] = Cells(a, "F")
ActiveSheet.[E5] = Cells(a, "G")
ActiveSheet.[D2:E200].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, "B") = Date
'Sheets(i).Cells(yeni, "B).NumberFormat = "dd/mm/yyyy"
Sheets(i).Cells(yeni, "B") = Cells(a, "D")
Sheets(i).Cells(yeni, "C") = Cells(a, "E")
Sheets(i).Cells(yeni, "D") = Cells(a, "F")
Sheets(i).Cells(yeni, "E") = Cells(a, "G")

'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, "D").NumberFormat = "#,##0.00 $"
Sheets(i).Cells(yeni, "E").NumberFormat = "#,##0.00 $"
Sheets(i).Range("A" & yeni & ":G" & 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, "D")
Sheets(i).Cells(yeni, "C") = Cells(a, "E")
Sheets(i).Cells(yeni, "D") = Cells(a, "F")
Sheets(i).Cells(yeni, "E") = Cells(a, "G")

Sheets(i).Cells(yeni, "D").NumberFormat = "#,##0.00 $"
Sheets(i).Cells(yeni, "E").NumberFormat = "#,##0.00 $"
Sheets(i).Range("A" & yeni & ":G" & yeni).Borders.LineStyle = xlContinuous
End If
End If
Next
End If

Sheets(dönem).Activate
End Sub
 

Ekli dosyalar

mars2

Altın Üye
Katılım
2 Eylül 2004
Mesajlar
570
Excel Vers. ve Dili
2016 - Türkçe
2019 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2026
Sayın pitchoute;
İlginiz için teşekkürker; ancak ay sayfasındaki "Alacaklı Hesap Kodu" na ait B sutunda ilgili hücreye hesap kodu yazdığımıda yeni sayfayı kod nosu ile açmaktadır. daha önceden açılan sayfanın alacak kısmına kayıt etmektedir.

Ayrıca,
  

Hesap Kodu (A1 hücresinde)

255.01 (B1 hücresinde )

Hesap Adı (A2) hücresinde)

Demirbaş Hesabı (B2 hücresinde)



Sizin makro ile aşağıdaki olmaktadır.

Hesap Adı

Demirbaş hesabı

Hesap Kodu

 
 

mars2

Altın Üye
Katılım
2 Eylül 2004
Mesajlar
570
Excel Vers. ve Dili
2016 - Türkçe
2019 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2026
Sayın pitchoute

İlginiz ve yardımınız için teşekkürker; ancak ay sayfasındaki "Alacaklı Hesap Kodu" na ait B sutunda ilgili hücreye hesap kodu yazdığımıda yeni sayfayı kod nosu ile açmaktadır. daha önceden açılan sayfanın alacak kısmına kayıt etmektedir.

Ayrıca,
  

Hesap Kodu (A1 hücresinde)

255.01 (B1 hücresinde )

Hesap Adı (A2) hücresinde)

Demirbaş Hesabı (B2 hücresinde)


Sizin makro ile aşağıdaki olmaktadır.

Hesap Adı

Demirbaş hesabı

Hesap Kodu

 

B sutunda hücreye 255.01 kodunu yazdığımda aşağıdaki gibi ayrı sayfa açmaktadır.

Ekli dosyayı görüntüle 254233
 

mars2

Altın Üye
Katılım
2 Eylül 2004
Mesajlar
570
Excel Vers. ve Dili
2016 - Türkçe
2019 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2026
Sayın pitchoute;

Tekarardan yardım ve ilginiz için teşekkürler,iş yoğunluğu nedeniyle biraz geç cevap verdiğim için özürümün kabul edileceği umuduyla, 2. verdiğiniz kodu da denemem rağmen aynı sorunlar devam etmekte olduğunu

Konu hakkında küçük hatırlatma yapmak istiyorum.
1- A sutunda bulunan kodla hesap adı ile sayfa açılmakta, B sutununda bulunan aynı kodla ayrı bir hesap açılmaktadır.
A sutunda Borç kodu, B sutunda ise Alacak kodu bulunmaktadır. Bu sutunlardaki kodlar aynı hesaba ait olup ayrı ayrı açılmamsı gerekmektedir. İster B sutununa göre isterse de A sutununa göre açılmış ise bunlar aynı hesap olup yeniden açılmasına gerek bulunmamaktadır.
Amaç açılan hesaplara, borçlu ve alacakların kayıtları aktarmak
2- Açılan sayfaların B1 hücresine hesabın kodu (Örneğin 255.01) B2 hücresine ise C sutununda bulunan hesabın adının yazılması. B1 hücresine hesabın kodu yazılmakta B2 hücresine ise hesabın adı yazılmamaktadı(Örneğin 255.01 ise Demirbaş hesabı gibi)
Yeni sayfa açılırken A1 hücresine sabit olarak "Hesabın kodu" A2 hücresien ise "Hesabın Adı" şeklinde matbu yazı çıkması
 

mars2

Altın Üye
Katılım
2 Eylül 2004
Mesajlar
570
Excel Vers. ve Dili
2016 - Türkçe
2019 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2026
İyi Akşamlar;
Konu hakkında yardımlarınız beklenmektedir.
 

mars2

Altın Üye
Katılım
2 Eylül 2004
Mesajlar
570
Excel Vers. ve Dili
2016 - Türkçe
2019 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2026
Konu hakkında yardımlarınız beklenmektedir.
 

mars2

Altın Üye
Katılım
2 Eylül 2004
Mesajlar
570
Excel Vers. ve Dili
2016 - Türkçe
2019 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2026
Sayın pitchoute;
ilginize teşekkürlere ancak, yukarıdaki kodu uyguladığımda hesap dosyası açıp aktarmıyor.

254303254304
254305 bunun gibi, olması gerekiyor
 
Üst