Sayfa1 dekileri diğer sayfalara nasıl aktarabilirim?

[assenucler]

Değerli dostlar;

Günaydınlar ve iyi hafta sonları.

Bir apartman yönetimindeyim. Profesyonel bir yazılım kullanıyoruz. Ay içinde çeşitli adlar adı altında toplanan paraları “Excele Aktar” düğmesi ile masaüstüm’deki “SenExcelAktar” adlı xls dosyasına aktarıyorum. Buradaki verileri süz, kopyala yapıştır ile kendime göre sayfalara manuel olarak aktarıyorum.

Ancak, bu işlemi tek bir düğmeye tıklayarak ya da başka bir yöntemde daha kolay ve bir sürede nasıl yapabilirim, bunu bilmiyorum.

Sayfa1’deki karışık olarak bulunan verileri :
1- Aidat adı “Aidat” olanı … Aidat sayfasına;
2- Aidat adı “Yakıt Aidatı” olanı … Yakıt sayfasına;
3- Aidat adı “Çatı aidatı” olanı … Çatı sayfasına;
4- İlk üç aidat adı dışında kalanları …. Diğer sayfasına

Hane No’ya göre sıralı olarak aktarmak istiyorum.

Çözüme ilişkin değerli yardımlarınızı bekliyorum.

Yardımlarınız için önceden teşekkürler.

 

[Merhum İdris SERDAR]

.

Buradaki örnekleri inceleyin.


http://www.excel.web.tr/f119/verileri-lgili-sayfalara-formul-makro-ile-daoytylmasy-t20271.html


.

 

[assenucler]

Sayın Yurttas;

Gününüz aydınlık, neşeniz sağlığınız yerinde ve kazancınız bol olsun.

Üstadım, kısa sürede yanıtınız ve yönlendirmeniz için teşekkürler.

Sevgi ve saygılar.

 

[asi_kral]

Merhaba
Syn : assenecler
Özel mesajınıza istinaden konunuza baktım.
Kitabınızın kod bölümünde bulunan Thisworkbook bölümüne

Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'Konu       :   Seçtiğim Sayfanın Verilerini Aktar
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Coder By:      asi_kral_1967
If ActiveSheet.Name <> "Sayfa1" Then
Dim asi As Worksheet, kral As Long
Dim a As Long, b As Variant
Application.ScreenUpdating = False
Set asi = Sheets("Sayfa1")
kral = asi.Range("A" & Rows.Count).End(xlUp).Row
Range("A2:H" & Rows.Count).ClearContents
b = ActiveCell.Address
If ActiveSheet.Name = "Aidat" Then
asi.Range("A6:H" & kral).AutoFilter Field:=3, Criteria1:="Aidat"
ElseIf ActiveSheet.Name = "Yakıt" Then
asi.Range("A6:H" & kral).AutoFilter Field:=3, Criteria1:="Yakıt Aidatı"
ElseIf ActiveSheet.Name = "Çatı" Then
asi.Range("A6:H" & kral).AutoFilter Field:=3, Criteria1:="Çatı Aidatı"
ElseIf ActiveSheet.Name = "Diğer" Then
asi.Range("A6:H" & kral).AutoFilter Field:=3, Criteria1:=Array("F.Borç", _
"Gecikme Faizi",[COLOR="Red"] "Su Boşaltma Geliri",[/COLOR] "Hurda Satış Geliri"), _
Operator:=xlFilterValues
End If
If WorksheetFunction.Subtotal(3, asi.Range("A7:A" & kral)) > 0 Then
asi.Range("A7:H" & kral).Copy: Range("A2").PasteSpecial (xlPasteValues)
End If
asi.Range("A6:H" & kral).AutoFilter
Range(b).Select
Application.ScreenUpdating = True
MsgBox ActiveSheet.Name & " Verilerini Aktardım", vbInformation, "asi_kral_1967"
End If
End Sub

Bu kodu kopyalayın ve deneyin.
Diğer Sayfasına Yeni eklemeleri kırmızı ile işaretlediğim şekilde yapabilirsiniz.
Dosyanız Ekte.

 

[assenucler]

Sayın asi Kral 1967;


Bu dinlence gününüzde zaman ayırarak verdiğiniz yanıt ve katkınız için en içten teşekkürlerimi sunarım.

Her şey gönlünüzce olsun...

Sevgi ve saygılar.

 

[assenucler]

Hata ileti nedeni ne olabilir?

Sayın asi Kral 1967 üstadım;

Ekli resimde de görüleceği gibi, "Su boşaltma Geliri" ve "Hurda Satış Geliri" kriterini "Diğer" sayfasına eklemek istediğimde hata iletisi çıkıyor.

Bu son eklediğim 2 kriter, senede 1-2 kez kullanılmaktadır.

Hata nedeni ne olabilir? Kodlarda yapılacak değişiklik ne olmalıdır?

 

[asi_kral]

Başka Kriter Olacak mı_?
Diğer'de. Onları da yazarsanız ona göre kodu düzenliyeyim.
Unutmayın kod yazarken tamamını söylemeniz karşınızda size yardım etmek isteyen kişinin bir seferde tam sonuca ulaşmasını sağlar. Değişiklik yaptığınızda karşınızdaki kişi sıkılır ve bir daha ki sizin sorularınıza yanıt vermemek için çaba gösterir.
Lütfen kod ile çözüm istediğinizde en ince ayrıntısına kadar anlatın ki. Sizin için ufak olan bir konu kod yazan için büyük sorun teşkil edebilir.

 

[assenucler]

Hayır "Diğer" sayfasına eklenecek 6. iletimdekilerin dışında kriter bulunmuyor.

Düşüncenize aynen katılıyorum. Başka bir isteğim olmayacaktır.

Teşekkürler.

 

[asi_kral]

Hayır "Diğer" sayfasına eklenecek 6. iletimdekilerin dışında kriter bulunmuyor.

Düşüncenize aynen katılıyorum. Başka bir isteğim olmayacaktır.

Teşekkürler.

Üstteki Mesajı ve Dosyayı güncelledim.
Birde Not yazdım. Kırmızı ile boyama hakkında.

 

[assenucler]

Değerli üstadım;


Günaydın, iyi haftalar ve bol kazançlar.

Eğitici ve yol gösterici yaklaşımınız ile bizlerin gönül dostusunuz.
Emek ve katkınız için Allah razı ve her şey gönlünüzce olsun.
Size ve sayın Yurttas'a bir kez daha teşekkürler.

Sevgi ve saygılar.

 

[asi_kral]

Değerli üstadım;


Günaydın, iyi haftalar ve bol kazançlar.

Eğitici ve yol gösterici yaklaşımınız ile bizlerin gönül dostusunuz.
Emek ve katkınız için Allah razı ve her şey gönlünüzce olsun.
Size ve sayın Yurttas'a bir kez daha teşekkürler.

Sevgi ve saygılar.

Kolay Gelsin.