Makro ile gelen verileri bir sayfada depolama

[kdr20_88]

Sayın EXCEL VİRTİÖZLERİ

Ekte gönderdiğim excel tablomda makro ile getirdiğim bilgilerin hepsinin bir sayfada alt alta toplanmasını istiyorum. Daha detaylı olarak ekteki dosyada anlattım.

Yardımlarınızı bekliyorum.

Teşekkürler.

 

[kdr20_88]

Yok mu yardım edebilecek bi usta yahu ?

 

[kdr20_88]

Arkadaşlar 1 kişi demi fikir sunmaz. basit bir cari hesap proğramı yaptım. aynı kişi için 2 ayrı cari hesap tutabiliyorum. listede istediğim üvana tıkladığımda otomatik sekme ekliyor. o sekmelerdeki işlemleri İŞLEMLER sekmesinde alt alta raporlamak yedeklemek istiyorummm. LÜTFEN YARDIM EDİN.

 

[kdr20_88]

Bu kadar mı zor bişey istedim ?

 

[Husgvarna]

Arkadaşlar 1 kişi demi fikir sunmaz. basit bir cari hesap proğramı yaptım. aynı kişi için 2 ayrı cari hesap tutabiliyorum. listede istediğim üvana tıkladığımda otomatik sekme ekliyor. o sekmelerdeki işlemleri İŞLEMLER sekmesinde alt alta raporlamak yedeklemek istiyorummm. LÜTFEN YARDIM EDİN.

Merhaba.
Aşağıdaki kodları "maaş" adlı butona ekleyip deneyin.
Ekteki dosyada kodlarınız bende hata verdiği için kodlar ayrı butonda.

For i = 1 To Sheets("İşlemler").Cells(65000, 1).End(xlUp).Row
If Sheets("İşlemler").Cells(i, 1) & Sheets("İşlemler").Cells(i, 2) = Cells(3, 2).Value & Cells(13, 1) Then GoTo m
Next

For a = 13 To Cells(65000, 1).End(xlUp).Row + Cells(65000, 8).End(xlUp).Row - 12
b = Sheets("İşlemler").Cells(65000, 1).End(xlUp).Row + 1
If Cells(a, 1) <> "" Then
c = c + 1
Sheets("İşlemler").Cells(b, 1) = Cells(3, 2)
Sheets("İşlemler").Range("b" & b & ":f" & b).Value = Range("a" & a & ":e" & a).Value
Else
Sheets("İşlemler").Cells(b, 1) = Cells(3, 2)
Sheets("İşlemler").Range("b" & b & ":f" & b).Value = Range("h" & a - c & ":l" & a - c).Value
End If
Next

m:

 

[kdr20_88]

Öncelikle Husgvarna arkadaşım yardımınız için teşekkür ederim. aslında istediğim olmuş. ama tam olarak ekteki gibi istiyorum kopyalama işlemini. ve burada önemli olan ben her işlem yaptığımda sadece yeni yaptığım işlemi kopyalasın. aksi taktirde mükerrer kayıt olur.

 

[Husgvarna]

Öncelikle Husgvarna arkadaşım yardımınız için teşekkür ederim. aslında istediğim olmuş. ama tam olarak ekteki gibi istiyorum kopyalama işlemini. ve burada önemli olan ben her işlem yaptığımda sadece yeni yaptığım işlemi kopyalasın. aksi taktirde mükerrer kayıt olur.

Yukarıdaki dosya değişti; incelermisiniz.

 

[kdr20_88]

malesef Husgvarna, ilk maaş hesapla dediğimde işlemi yaptığımda aktarmayı yapıyor. sonra bidaha yapmıyor. bir seferlik çalışıyor bu buton. ve dikkat ettiysen liste kısmındaki isimlere her tıkladığında o isim için yeni bir sekme açıyor. yani bütün sekmeleri İŞLEMLER sayfasında alt alt ekleye ekleye gitmeli. istediğim buydu.

 

[Husgvarna]

malesef Husgvarna, ilk maaş hesapla dediğimde işlemi yaptığımda aktarmayı yapıyor. sonra bidaha yapmıyor. bir seferlik çalışıyor bu buton. ve dikkat ettiysen liste kısmındaki isimlere her tıkladığında o isim için yeni bir sekme açıyor. yani bütün sekmeleri İŞLEMLER sayfasında alt alt ekleye ekleye gitmeli. istediğim buydu.

 [COLOR="Red"]For i = 1 To Sheets("İşlemler").Cells(65000, 1).End(xlUp).Row
If Sheets("İşlemler").Cells(i, 1) & Sheets("İşlemler").Cells(i, 2) = Cells(3, 2).Value & Cells(13, 1) Then GoTo m
Next[/COLOR]

For a = 13 To Cells(65000, 1).End(xlUp).Row + Cells(65000, 8).End(xlUp).Row - 12
b = Sheets("İşlemler").Cells(65000, 1).End(xlUp).Row + 1
If Cells(a, 1) <> "" Then
c = c + 1
Sheets("İşlemler").Cells(b, 1) = Cells(3, 2)
Sheets("İşlemler").Range("b" & b & ":f" & b).Value = Range("a" & a & ":e" & a).Value
Else
Sheets("İşlemler").Cells(b, 1) = Cells(3, 2)
Sheets("İşlemler").Range("b" & b & ":f" & b).Value = Range("h" & a - c & ":l" & a - c).Value
End If
Next

m:

Kodların üst kısmında bulunan kırmızı bölüm aktarılacak ismin ve tarihin İŞLEMLER sayfasında bulunup bulunmadığını kontrol edip mükerrer aktarmayı engellemek içindi. İlgili bölümü silerseniz kontrol yapmadan verileri gönderir.