Sayfadan sayfaya alt alta kopyala

[erol19]

Değerli Abilerim,
Sayfa1'deki Açılır kutudan rakam seçiyorum ve J1'e (1,2,3...200,...) rakamlarından birisini yazdırıyorum. J1'hücresine yazılan rakamları aşağıdaki kod ile Sayfa3'ün A1 stununa alt alta kopyala yapıştır yaptırmak istiyorum.(Buton yok, sadece açılır kutudan hangi rakamı seçersem...)
ALLAH RAZI OLSUN

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Integer

For x = 1 To 2000
Sheets("Sayfa1").Cells(I, 13).Value = Sheets("Sayfa3").Cells(A, 1).Value
Next x

End Sub

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
sonsat=worksheetfunction.counta(sheets("sayfa3").[a:a])+1
Sheets("Sayfa3").Cells(sonsat, "a")=[j1]
End Sub

 

[erol19]

Çalışmadı

Sayın Hocam, Yukarıdaki kodu çalıştıramadım.
Aşağıdaki kod ile sayfa1 (A1)deki bir rakamı, Sayfa2'nin (C) sutununa tuş marifetiyle 200 tane kopyalama yaptırabildim.

İstiyorum ki, Sayfa1'in A1'ine ne yazarsam, Sayfa2'nin C stununa alt alta yazdırsın. Ne zaman yazdıracak? Ben Sayfa1'in A1'ine yazdıkça o, sayfa2'deki ilgili stuna alt alta ekleme yapsın...

Private Sub CommandButton10_Click() Buradaki buttona gerek kalmasın.
Worksheets("Sayfa1").Range("A1").Copy Worksheets("Sayfa2").Range("C1:C200")
End Sub
Hürmetlerimle..

 

[Qene]

Private Sub Worksheet_Change(ByVal Target As Range)
....
Kodları yazın
End Sub

 

[erol19]

Olmadı.

Aşağıdaki kodları module yazdım. Tek girişte 200 tansini alt alta yazdı.
ÖR:Sayfa1'deki A1'e 5 yazınca Sayfa2'deki "C1" stununa 5 yazsın.
A1'e 6 " " C2 " 6 "
..............................................................
..............................................................

A1'e 10 " " C3 " 10 "

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheets("Sayfa1").Range("A1").Copy Worksheets("Sayfa2").Range("C1:C200")
End Sub

 

[Qene]

If Target.Address(0, 0) = "A1" Then 
        Worksheets("Sayfa2").Range("C1").Offset(WorksheetFunction.CountIf(Worksheets("Sayfa2").Range("C:C"), "<>"), 0) = [A1] 
    End If