• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Sayfaya Aktarma

kemalist

kemalist

Katılım
4 Haziran 2008
Mesajlar
798
Excel Vers. ve Dili
Excel 2021 TÜRKÇE
Arkadaşlar sayfaya makro ile veri aktarma konusunda yardımcı olurmusunuz?makrolarla daha yeni tanışıyorum.öernek dosya ektedir.
 

Ekli dosyalar

Merhaba
GİRİŞ sayfası koduna
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target.Rows, [f3:f37]) Is Nothing Then GoTo 1
Set sat = Sheets("PERSONEL").[c:c].Find(Range("C2"), lookat:=xlWhole)
If Not sat Is Nothing Then
    sat = sat.Row
Else
    sat = Sheets("PERSONEL").[C65536].End(3).Row + 1
    Sheets("PERSONEL").Cells(sat, 3) = CDate([C2])
End If
Set sut = Sheets("PERSONEL").Rows(2).Find(Cells(Target.Row, 3), lookat:=xlWhole)
If Not sut Is Nothing Then
    Sheets("PERSONEL").Cells(sat, sut.Column) = Target.Value
End If
1 If Intersect(Target.Rows, [J4:J14]) Is Nothing Then GoTo 2
Set sat = Sheets("GİDERLER").[c:c].Find(Range("C2"), lookat:=xlWhole)
If Not sat Is Nothing Then
    sat = sat.Row
Else
    sat = Sheets("GİDERLER").[C65536].End(3).Row + 1
    Sheets("GİDERLER").Cells(sat, 3) = CDate([C2])
End If
Set sut = Sheets("GİDERLER").Rows(2).Find(Cells(Target.Row, 9), lookat:=xlWhole)
If Not sut Is Nothing Then
    Sheets("GİDERLER").Cells(sat, sut.Column) = Target.Value
End If
2 If Intersect(Target.Rows, [J21:J32]) Is Nothing Then exit sub
Set sat = Sheets("GELİRLER").[c:c].Find(Range("C2"), lookat:=xlWhole)
If Not sat Is Nothing Then
    sat = sat.Row
Else
    sat = Sheets("GELİRLER").[C65536].End(3).Row + 1
    Sheets("GELİRLER").Cells(sat, 3) = CDate([C2])
End If
Set sut = Sheets("GELİRLER").Rows(2).Find(Cells(Target.Row, 9), lookat:=xlWhole)
If Not sut Is Nothing Then
    Sheets("GELİRLER").Cells(sat, sut.Column) = Target.Value
End If
End Sub
 
Son düzenleme:
Giriş sayfasına vermiş olduğunuz kodu girdim bir hata yaptım galiba ama nerede yaptığımı bilmiyorum.kısacası çalışmıyor.dosyayı yeni haliyle tekrar yolluyorum.
Yardımlarınız için şimdiden teşekkür ederim.
 

Ekli dosyalar

kemalist' Alıntı:
Giriş sayfasına vermiş olduğunuz kodu girdim bir hata yaptım galiba ama nerede yaptığımı bilmiyorum.kısacası çalışmıyor.dosyayı yeni haliyle tekrar yolluyorum.
Yardımlarınız için şimdiden teşekkür ederim.
Genişletmek için tıkla ...

F sutunuda Ve J sutununda belirtiğiniz alanlara veri girildikce kayıt yapacaktır.
Bu alanlara veri girerek deneyiniz. Butona bağlı değil.
 
meslan' Alıntı:
f sutunuda ve j sutununda belirtiğiniz alanlara veri girildikce kayıt yapacaktır.
Bu alanlara veri girerek deneyiniz. Butona bağlı değil.
Genişletmek için tıkla ...

sayın meslan ilginiz için teşekkür ederim.yalnız dosyada bazı şeyler ilave edince l sütununa girdiğim veriler gelirler ve giderler dosyalarına gitmiyor.verdiğiniz kodda değişiklik yapmaya çalıştım ama beceremedim.kodları değiştirerek yollarsanız sevinirim.şimdiden çok teşekkürler.
Ekli dosya ektedir.
Iyiki excel forum var.
 

Ekli dosyalar

Merhaba
Gerkli değişiklikler yapılmıştır.
İyi geceler
 

Ekli dosyalar

BEN SRU SRULACAK YERİ BULAMADIM BURAYA YAZDIM BİR SUTUNDA VEYA BİR KAÇ SUTUNDA METİNLER BULUNSUN BEN SEÇTİĞİM SUTUNLARDAKİ METİNLERİ TEK BİR SUTUNDA ToPLAMAK İSTİYoRUM BU MÜMKÜNMÜ YARDIMCI oLURSANIZ SEVİNİRİM
 
matek' Alıntı:
BEN SRU SRULACAK YERİ BULAMADIM BURAYA YAZDIM BİR SUTUNDA VEYA BİR KAÇ SUTUNDA METİNLER BULUNSUN BEN SEÇTİĞİM SUTUNLARDAKİ METİNLERİ TEK BİR SUTUNDA ToPLAMAK İSTİYoRUM BU MÜMKÜNMÜ YARDIMCI oLURSANIZ SEVİNİRİM
Genişletmek için tıkla ...

Sayın Mastek,
Başkasının konusu içinde farklı soru sormayınız.
Soru sorulacak yer nasıl bulamıyorsunuz? Ana sayfaya gidiniz. aşağıya doğru ininiz Örnek olarak "Fonksiyonlar" bölümünü göreceksiniz. Tıklayınız. yine biraz aşağı doğru geliniz. Sol ksımıda "Yeni Konu" düğmesine tıklayınız.
 
meslan' Alıntı:
merhaba
gerkli değişiklikler yapılmıştır.
Iyi geceler
Genişletmek için tıkla ...

sayın meslan göndermiş olduğunuz dosyada bir-iki değişklik yaptım
karşıma
compile error
expected:expression

diye mesaj çıkıyor.kodlarda düzenleme yapmaya çalıştım ama beceremedim.rica etsem tekrar yardımcı olurmusunuz?
şimdiden çok teşekkürler....

Dosya ektedir.
 

Ekli dosyalar

Merhaba
Giriş sayfası sekmesi> sağ klik >Kod görüntüle
Çıkan erana bu kodlar. Kolay gelsin.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target.Rows, [f3:f52]) Is Nothing Then GoTo 1
Set sat = Sheets("PERSONEL").[c:c].Find(Range("C2"), lookat:=xlWhole)
If Not sat Is Nothing Then
    sat = sat.Row
Else
    sat = Sheets("PERSONEL").[C65536].End(3).Row + 1
    Sheets("PERSONEL").Cells(sat, 3) = CDate([C2])
End If
Set sut = Sheets("PERSONEL").Rows(2).Find(Cells(Target.Row, "C"), lookat:=xlWhole)
If Not sut Is Nothing Then
    Sheets("PERSONEL").Cells(sat, sut.Column) = Target.Value
End If
1 If Intersect(Target.Rows, [L4:L52]) Is Nothing Then GoTo 2
Set sat = Sheets("GİDERLER").[c:c].Find(Range("C2"), lookat:=xlWhole)
If Not sat Is Nothing Then
    sat = sat.Row
Else
    sat = Sheets("GİDERLER").[C65536].End(3).Row + 1
    Sheets("GİDERLER").Cells(sat, 3) = CDate([C2])
End If
Set sut = Sheets("GİDERLER").Rows(2).Find(Cells(Target.Row, "K"), lookat:=xlWhole)
If Not sut Is Nothing Then
    Sheets("GİDERLER").Cells(sat, sut.Column) = Target.Value
End If
2 If Intersect(Target.Rows, [P4:P22]) Is Nothing Then Exit Sub
Set sat = Sheets("GELİRLER").[c:c].Find(Range("C2"), lookat:=xlWhole)
If Not sat Is Nothing Then
    sat = sat.Row
Else
    sat = Sheets("GELİRLER").[C65536].End(3).Row + 1
    Sheets("GELİRLER").Cells(sat, 3) = CDate([C2])
End If
Set sut = Sheets("GELİRLER").Rows(2).Find(Cells(Target.Row, "O"), lookat:=xlWhole)
If Not sut Is Nothing Then
    Sheets("GELİRLER").Cells(sat, sut.Column) = Target.Value
End If
End Sub
 
sayın meslan verdiğiniz kodu girdim fakat f33 e girdiğim değer f32 ye girmiş gibi kaydediyor.birde sarı ile boyalı hücrelere veri girdiğimde ilgili sayfaya kaydetmiyor.sanırım bir yanlışlık oldu dosyayı düzeltilmiş halde rar dosyası şeklinde koyarsanız sevinirim.ilgili dosya ektedir.yardımlarınız için şimdiden çok teşekkür ederim. o sütununda sorun yok.
 

Ekli dosyalar

Merhaba
F sutunuda işaretlediğiniz yerlerin karşılıkları yok.
L sutununda işaretlediğiniz yerde K sunundaki karşılıklarında boşluk var.
C sutunu ve K sutununun da yer alan kalemler aynen gerekli sayfalarda yer alması gerekiyor.
Buna göre düzenleme yapınız. Hiç bir problem olmaz.
Selamlar.
 
meslan' Alıntı:
Merhaba
F sutunuda işaretlediğiniz yerlerin karşılıkları yok.
L sutununda işaretlediğiniz yerde K sunundaki karşılıklarında boşluk var.
C sutunu ve K sutununun da yer alan kalemler aynen gerekli sayfalarda yer alması gerekiyor.
Buna göre düzenleme yapınız. Hiç bir problem olmaz.
Selamlar.
Genişletmek için tıkla ...

merhaba meslan açıklamalarınız sayesinde sorun çözüldü.Herşey için teşekkür ederim....
 
Yukarıda firma adıyla listelenmiş bölümden istediğim firmanın başka sayfada raporlanmasını istiyorum fakat birtürlü yapamadım bana yardımcı olacak,ve bunun makrosunu yazacak arkadaşlara şimdiden teşekkür ederim saygılar sevgiler.
 

Ekli dosyalar

Merhaba
Bunu
If S1.Cells(X, 4) = S1.[H1] Then
Buna
If S1.Cells(X, 2) = S1.[H1] Then
değiştir. Tamam
 
Yukarıda firma adıyla listelenmiş bölümden istediğim firmanın başka sayfada raporlanmasını istiyorum fakat birtürlü yapamadım bana yardımcı olacak,ve bunun makrosunu yazacak arkadaşlara şimdiden teşekkür ederim saygılar sevgiler.
 

Ekli dosyalar

bayteksan' Alıntı:
Yukarıda firma adıyla listelenmiş bölümden istediğim firmanın başka sayfada raporlanmasını istiyorum fakat birtürlü yapamadım bana yardımcı olacak,ve bunun makrosunu yazacak arkadaşlara şimdiden teşekkür ederim saygılar sevgiler.
Genişletmek için tıkla ...

Sanırım mesajımı dikkate almadın.
sadece belirttiğim değişikliği yaptım.
Buyurun dosyanız.
 

Ekli dosyalar

Sayın meslan yardımın için çok teşekkür ederim.Benim istediğim buydu.Ancak bir sorum olacak aktarma yaptığında neden YTL çıkıyor...İlginiz çok teşekkür ederim...
 
Merhaba
YTL hücre biçiminden
İlgili sutunu isteğinize göre biçimleyin.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst