• DİKKAT

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

Buton ile bir hücreyi başka bir hücreye alt alta kopyalama

C

caparso2002

Katılım
1 Ağustos 2005
Mesajlar
22
arkadaşlar benim sizden bir isteğim var, yardımcı olursanız çok minnettar olacağım.
benim amacım bir hücredeki veriyi başka bir hücreye her defasında bir alt satırına kopyalatmak istiyorum.
yani ekte göreceksiniz, akbnk isimli çalışma sayfamda bulunan K22 hücresindeki veriyi ak_tks isimli çalışma sayfasındaki B2 hücresine kopyalatacak bir buton olsun istiyorum. yalnız bu butona her basışta bir alt satıra kopyalama yapacak.(B2, B3, B4..... aşağı doğru kopyalayacak.)
yan sütunda bulunan A2 hücresinede butona bastıkça o günün tarihini yazacak.
teşekkürler
 

Ekli dosyalar

Son düzenleme:
Dosyanız ekte.:cool:
Kod: 
Sub K22_al()
Dim sat As Long
Sheets("ak_tks").Select
sat = Cells(65536, "A").End(xlUp).Row + 1
If sat >= 65533 Then
    MsgBox "Satır doldu başka kayıt yapamazsınız..", vbCritical, "UYARI"
    Exit Sub
End If
Cells(sat, "A").Value = Date
Cells(sat, "A").NumberFormat = "dd.mm.yyyy"
Cells(sat, "B").Value = Sheets("akbnk").Cells(22, "K").Value
Cells(sat, "B").NumberFormat = "#,##0.00"
End Sub
 

Ekli dosyalar

Kod: 
Private Sub CommandButton1_Click()
i = Sheets("ak_tks").Cells(65536, 1).End(xlUp).Row + 1
Sheets("ak_tks").Cells(i, 1).Value = Now
Sheets("ak_tks").Cells(i, 2).Value = Sheets("akbnk").Cells(22, "k").Value
End Sub

merhaba, dosyanız ekte iyi çalışmalar.
 

Ekli dosyalar

çok tşk ederim arkadaşlar.Elinize emeğinize sağlık çok süper oldu benim için.
bir kaç sorunumda daha sizleri rahatsız edeceğim.
iyi akşamlar
 
Evren Gizlen hocam

Evren Gizlen' Alıntı:
Dosyanız ekte.:cool:
Kod: 
Sub K22_al()
Dim sat As Long
Sheets("ak_tks").Select
sat = Cells(65536, "A").End(xlUp).Row + 1
If sat >= 65533 Then
    MsgBox "Satır doldu başka kayıt yapamazsınız..", vbCritical, "UYARI"
    Exit Sub
End If
Cells(sat, "A").Value = Date
Cells(sat, "A").NumberFormat = "dd.mm.yyyy"
Cells(sat, "B").Value = Sheets("akbnk").Cells(22, "K").Value
Cells(sat, "B").NumberFormat = "#,##0.00"
End Sub
Genişletmek için tıkla ...

kodunuz için teşekkür ederim.
fakat bir sorunum var benim.
k22_al makrosu tanımlamışsınız.
size gönderdiğim dosyada 2 tane çalışma sayfası vardı(akbnk ve ak_tks) yalnız benim asıl kullanacağımda 120 tane çalışma sayfası var. bu durumda ben 50 tane makromu tanımlayayayım.
bu işin bir pratiği varmı.
teşekkürler.
 
sayfa isimleri standart mı yoksa hepsi farklı isimlere mi sahip
 
hepsi farklı isimlerde, bunlar hisse ismi yaklaşık 60 hisse var bu 60 hisse içinde 60 tane takas sayfası var.
 
Bir kaç sayfa dağa ekleyin ve ne yapılacağını burada daha açık anlatın.:cool:
 
syfa ekledim ve anamenü yapmak istiyorum

arkaşlar ekteki dosyamda 120 sayfa vardı ben çoğunu silip yeniden koydum.
sayfaların isimleri hisse isimleri(aefes) ve hisselere ait takas sayfaları var (aefes_t) şeklinde.
benim amacım
benim amacım her hissenin takas bilgisini her hisseye ait sayfada bulunan k22 hücresinden alacak ve hisseye ait takas sayfasında bulunan (hisseadi_t) b2 hücreinden başlayarak kopyalayacak.
yine her hissesnin fiyat bilgisini her hisseye ait sayfada bulunan n15 hücrsinden alacak ve hisseye ait takas sayfasında bulunan (hisseadi_t) c2 hücrsindenbaşlayarak kopyalayacak.
ayrıca butona basında o gunun tarihinide a sütununa yazacak.
bu sorunumu Evren Gizlen hocam halletti.
akbnk sayfası düzgün çalışıyor.
evren hocam akbnk sayfası için buton yapmış butona basınca akbnt_tks sayfasında gerekli işlemleri yapıyor.
ben diğer sayfalar içinde böyle bir işlem yapılsın istiyorum.
akbnk sayfasındaki makroyu 60 defa diğer sayfalar için kullanacakmıyım.
60 tane ayrı makromu tanımlayım.
sorunum bu arkadaşlar yardım ederseniz sevinirim.

bu sorunu hallettikden sonra şöyle bir anamenü yapmayı düşünüyorum.
bu konudaki fikirlerinizi paylaşırsanız sevinirim.
anamenüde hisselerin takas sayfasında bulunan tarih hisse fiyatı ve takas sütunlarını kullanarak grafik çizdireceğim.
ben bir butona basında tüm sayfalarda bulunan ctrl+T kısayollu makroyu ardından ctrl+V kısayollu makroyu ve bu kopyalama işini yapan makroyu tüm sayfalar için ayrı ayrı uygulatmam lazım.
bunun da basit bir yolu varmıdır.
program ondan sonra bitiyor.
 

Ekli dosyalar

sayfa isimleri
akbnk-ak_tks
akcns-akcns_t
şeklinde hepsi akcns-akcns_t şeklinde olsa bir yöntem olabilir.ama değişik oldugu için aklıma gelen çözüm sayfanın boş olan herhangibi bir hücresini kullanmak.örnegin ak_tks sayfasının ve diger al butonu olan sayfaların e1 hücresine bir defalığına ilgili sayfa isimlerini yazarsanız sayın Evren GİZLEN'in kodlarını bu şekilde kullanabiliriz.Tabi Evren hocamızın daha işlevsel yanıtı olabilir.
not:al butonu takas sayfalarında ise

Kod: 
Sub K22_al()
Dim sat As Long
Dim sf As Worksheet
Set sf = Sheets(Cells(1, 5))
sat = Cells(65536, "A").End(xlUp).Row + 1
If sat >= 65533 Then
    MsgBox "Satır doldu başka kayıt yapamazsınız..", vbCritical, "UYARI"
    Exit Sub
End If
Cells(sat, "A").Value = Date
Cells(sat, "A").NumberFormat = "dd.mm.yyyy"
Cells(sat, "B").Value = sf.Cells(22, "K").Value
Cells(sat, "B").NumberFormat = "#,##0.00"
End Sub
 
akbnk sayfasının takas sayfası adını değiştirebilirim sorun değil.
yani hisseadi_t olabilir tum sayfalar.zaten sadece akbnk sayfasında isim farklı yanlışlıkla yapmıştım birdaha da değiştirmemiştim.
 
dosyayı inceleyin;
Kod: 
Sub K22_al()
Dim sat As Long
Cells(1, 254).Value = ActiveSheet.Name
 Cells(1, 255).Value = "=LEFT(RC[-1],LEN(RC[-1])-2)"
  Set sf = Sheets(Cells(1, 255).Value)
sat = Cells(65536, "A").End(xlUp).Row + 1
If sat >= 65533 Then
    MsgBox "Satır doldu başka kayıt yapamazsınız..", vbCritical, "UYARI"
    Exit Sub
End If
Cells(sat, "A").Value = Date
Cells(sat, "A").NumberFormat = "dd.mm.yyyy"
Cells(sat, "B").Value = sf.Cells(22, "K").Value
Cells(sat, "B").NumberFormat = "#,##0.00"
Cells(sat, "C").Value = sf.Cells(15, "N").Value
Cells(sat, "C").NumberFormat = "#,##0.00"
End Sub
 

Ekli dosyalar

fedeal' Alıntı:
dosyayı inceleyin;
Kod: 
Sub K22_al()
Dim sat As Long
Cells(1, 254).Value = ActiveSheet.Name
 Cells(1, 255).Value = "=LEFT(RC[-1],LEN(RC[-1])-2)"
  Set sf = Sheets(Cells(1, 255).Value)
sat = Cells(65536, "A").End(xlUp).Row + 1
If sat >= 65533 Then
    MsgBox "Satır doldu başka kayıt yapamazsınız..", vbCritical, "UYARI"
    Exit Sub
End If
Cells(sat, "A").Value = Date
Cells(sat, "A").NumberFormat = "dd.mm.yyyy"
Cells(sat, "B").Value = sf.Cells(22, "K").Value
Cells(sat, "B").NumberFormat = "#,##0.00"
Cells(sat, "C").Value = sf.Cells(15, "N").Value
Cells(sat, "C").NumberFormat = "#,##0.00"
End Sub
Genişletmek için tıkla ...

çok teşekkür ederim fedeal hocam.
ben program üzerinden çalışırken şöyle bir sorunla karşılaştım.
ekteki dosyada göreceksiniz.
aefes akbnk ve akcns sayfaları için gelişmiş filtre uyguladım.
filtrede liste aralığı; $B$28:$J$216
ölçüt aralığı; $B$6:$B$9
hedef; $B$18:$J$21
yani CITIBANK YABANCI N.A , DEUTSCHE BANK (YABANCI) , TURK EKONOMI BANK (YABANCI) ve EURO BANK TEKFEN A.Ş. isimleri filtre uygulayacağım listede varsa b18 j21 satırlarına bunların bilgilerini yazıyor.
filtre akbnk sayfasında çalışıyor ama diğer sayfalarda çalışmıyor.
sebebini anlayamadım.
bu ü sayfa arasında tek fark sadece akbnk sayfasında en üstteki veri CITIBANK YABANCI N.A
yardımcı olabilirmisiniz.
 

Ekli dosyalar

Arkadaşlar merhaba,

Benim de bu konudakine benzer, ufak değişikliklerle çözüleceğini düşündüğüm bir sorum var, kendi başıma halledemedim. Yardımcı olursanız çok sevinirim. Eklediğim dosyada A1 : D19 arası başka sayfadan formülle sürekli değişen verilere sahip. Kullanıcı bu aralığı her değiştirdiğinde makroyu çalıştırıp sayfa2'ye bu verileri alt alta atabilmeli. Sayfa1'de 19 satırlık maksimum bir değer bıraktım, bu 1 satırla da kısıtlı kalabilir, bir sonraki veri geldiğinde 18 satırlık boş alan da kalmamalı. Ki bu 18 satırlık boş alan yine de formül içeren "" şeklindeki hücreler. Yani diyelim ki ilk verilen değer sonucu sayfa1'de 14 satır çıktı, makroyu çalıştırdık, 19 satırı sayfa2'ye attı (5 satırı boş olmak üzere), ikinci verilen değer ile 3 satır çıktı yine makroyu çalıştırdık, 19 satırı sayfa2'ye attı. (16'sı boş olmak üzere) Sayfa2'de toplam 14+3=17 satırlık alan olmalı. Ayrıca yine önceki konuda olduğu gibi atama yapıldığında, atamanın tarihi ve saati ek bir sütun olarak sayfa2'ye gelmeli.

Yardımlarınızı rica ederim. :roll:
 

Ekli dosyalar

Son düzenleme:
İstediğiniz Sayfa1'deki verilerin boşluksuz olarak Sayfa2'de ilk boş satırdan itibaren aktarılmasıysa aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Kod: 
Sub aktar()
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
    son = s1.Cells(Rows.Count, "A").End(3).Row
    yeni = s2.Cells(Rows.Count, "A").End(3).Row
    If s2.Cells(yeni, "A") <> "" Then yeni = yeni + 1
    s1.Range("A1:D" & son).Copy: s2.Cells(yeni, "A").PasteSpecial Paste:=xlPasteValues
    s2.Select
    s2.Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete
End Sub

Bu arada aklınızda olsun, sorunuzu yeni başlığa değil de eski başlıklara sorarsanız okunma olasılığınız düşer.
 
Çok teşekkür ederim. Açıkçası konu tekrarı/kirliliği yaratmamak ve derli toplu olması açısından eski konuya yazdım ama önerinizi dikkate alacağım.

Kod çalışıyor ancak

Selection.SpecialCells(xlCellTypeBlanks).Select

satırında debug veriyor. Bir de sayfa2'ye aktarma yapıldığı anın tarih ve saatini yanına bir sütuna getirebilir miyiz yazmıştım. O konuda da yardımcı olabilir misiniz?
 
Örnek dosyanızı aslına uygun olarak formüllü şekilde paylaşırsanız iyi olur. Bende hata vermedi çünkü. Muhtemelen formülsüz olduğundandı. Diğer dediğiniz kolay.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst