Hücreye Girilen Veri Kadar Farklı Sayfaya Kayıt Etmek

[kkaplan]

Merhaba,

Sayfa1 de yer alan aşağıdaki tablodaki hücrelere veriyi, eklenen düğmeyle eklenen veri kadar seçip; örneğin 2 satır veri girildi ve ekle düğmesine tıklandığında seçip Sayfa2 de yer alan tabloya kaldığı yerden devam edip ekleyecek. Sonrasında da bu tabloyu temizleyecek.

Seçme işlemini yaptım ancak kayıt etme ve tabloyu temizleme işlemini tamamlayamadı. Bu konuda yardımcı olabilir misiniz.

Ürün Adı

Miktar

Fiyat

Toplam

Seçim Komutu düzgün çalışıyor.

Sub Sec()
Dim Say As Integer
Dim Sayfa As Worksheet
Set Sayfa = Worksheets("Sayfa1")
Say = Sayfa.Cells(Sayfa.Rows.Count, "B").End(xlUp).Row
If Say < 2 Then
MsgBox "Tabloda veri yok!", vbCritical
Exit Sub
End If
Sayfa.Range("B8:F" & Say).Copy
End Sub

 

[Muzaffer Ali]

Merhaba.

Sub Test()
    Dim Say As Integer
    Dim Say2 As Integer
    Say = Worksheets("Sayfa1").Cells(Rows.Count, "B").End(xlUp).Row
    Say2 = Worksheets("Sayfa2").Cells(Rows.Count, "B").End(xlUp).Row
    If Say > 1 Then
        Worksheets("Sayfa1").Range("B2:F" & Say).Copy Worksheets("Sayfa2").Cells(Say2 + 1, "B")
    Else
        MsgBox "Tabloda veri yok!", vbCritical
    End If
End Sub

 

[kkaplan]

Merhaba.

Sub Test()
    Dim Say As Integer
    Dim Say2 As Integer
    Say = Worksheets("Sayfa1").Cells(Rows.Count, "B").End(xlUp).Row
    Say2 = Worksheets("Sayfa2").Cells(Rows.Count, "B").End(xlUp).Row
    If Say > 1 Then
        Worksheets("Sayfa1").Range("B2:F" & Say).Copy Worksheets("Sayfa2").Cells(Say2 + 1, "B")
    Else
        MsgBox "Tabloda veri yok!", vbCritical
    End If
End Sub

Muzaffer Bey desteğiniz için teşekkür ederim, son olarak eksik bilgi vermişim kayıt etmek istediğim tablodaki verilerde formüller de onları Sayfa2 ye veri olarak aktarmasını istiyorum. Örneğin Fiyat sütununda Düşeyara formülü var Sayfa2 ye formül olarak çekiyor ben 110 TL olarak veri çekmesini istiyorum. Bu konuda da yardımcı olabilir misiniz.

 

[Muzaffer Ali]

Aşağıdaki kodu kullanın.

Sub Test()
    Dim Say As Integer
    Dim Say2 As Integer
    Say = Worksheets("Sayfa1").Cells(Rows.Count, "B").End(xlUp).Row
    Say2 = Worksheets("Sayfa2").Cells(Rows.Count, "B").End(xlUp).Row
    If Say > 1 Then
        Worksheets("Sayfa1").Range("B2:F" & Say).Copy
        Worksheets("Sayfa2").Cells(Say2 + 1, "B").PasteSpecial xlPasteValues
    Else
        MsgBox "Tabloda veri yok!", vbCritical
    End If
End Sub

 

[kkaplan]

Muzaffer Bey destekleriniz için çok teşekkür ederim. Formül tam istediğim şekilde çalıştı.