İki sayfa arası veri aktarımı

[ridvan2111]

Merhaba,
Yapmak istediğim
1. Dıs_Verial sayfasını tüm dolu satırları kopyalayarak Sipariş_Girişi sayfası son dolu satırın altına yapıştıracak.
2. aynı işlemi tekrar yapacak fakat son yapıştırdığı satırlar K sutunu "Sipariş" olarak değişmeli ve L ve M sutunlarındaki değerler - olmalı

Örnek mesela Dıs_Verial sayfasından Sipariş_Girişi sayfasına 3 satır aktardı buraya K sutunu "Nakışta" olarak gelir L 50 ve M 50 olsun aynı işlemi tekrar yaptı şimdi bu 3 satır K sutunu "Sipariş" olmalı ve L sutunu -50 M sutunu -50 olmalı.

Bu işlem sunucunda Sipariş_Girişi sayfasında şarta göre toplama yaptırarak sipariş deposundan nakış deposuna kupon mikarı aktarmış olacağım

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz.

Sub SIPARISE_AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, Satir As Long, Son_Satir As Long
    
    Set S1 = Sheets("Dis_Verial")
    Set S2 = Sheets("Siparis_Girisi")
    
    Satir = S1.Cells(Rows.Count, 1).End(3).Row
    If Satir > 1 Then
        S1.Range("A2:AF" & Satir).Copy S2.Cells(Rows.Count, 1).End(3)(2, 1)
        Son_Satir = S2.Cells(Rows.Count, 1).End(3).Row + 1
        S1.Range("A2:AF" & Satir).Copy S2.Cells(Rows.Count, 1).End(3)(2, 1)
        S2.Range("K" & Son_Satir & ":K" & Son_Satir + Satir - 2) = "Sipariş"
        S2.Range("XFD1") = -1
        S2.Range("XFD1").Copy
        S2.Range("L" & Son_Satir & ":M" & Son_Satir + Satir - 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply
        Application.CutCopyMode = False
        MsgBox "Bilgiler aktarılmıştır.", vbInformation
    End If
End Sub

 

[ridvan2111]

Korhan Bey Teşekkürler.