Sayfalar arası veri aktarımı

[acetinnster]

Arkadaşlar ek te ki dosya ile ilgili sayfalar arası veri aktarımı ile ilgili yardımcı olabilirmisiniz

 

[askm]

Aşağıdaki kodları kullanabilirsiniz.

Sub askm()
Dim s1, s2 As Worksheet
Set s1 = Sheets("AÇIK SİPARİŞLER")
Set s2 = Sheets("SEVKEDİLEN SİPARİŞLER")
Dim Son1, Son2 As Long
Son1 = s1.Range("A" & Rows.Count).End(xlUp).Row
s2.Range("a2:AJ65000").ClearContents
For i = 2 To Son1
    If s1.Cells(i, "AJ") = "SEVK EDİLDİ" Then
        Son2 = Range("A" & Rows.Count).End(xlUp).Row + 1
        s1.Range("A" & i & ":AJ" & i).Copy s2.Cells(Son2, "A")
    End If
Next
MsgBox "SEVK EDİLEN kayıtların aktarma  işlemi tamamlandı..." & Chr(10) & Chr(10) & "İyi çalışmalar...", vbInformation, "ASKM"
End Sub

 

[acetinnster]

askm hocam ilgilendiğiniz için tekrar tekrar teşekkürler
Yalnız düzeltmenizi rica edeceğim 2 husus var
1.Sevk edildi seçimi olan satırda en sondaki satırı aktarmakta tüm sevk edildi satırları aktarılması gerekmekte
2.Aktarım yapıldıktan sonra ise aktarım yapılan satırı ya keserek aktarım yapılsın ya da o satırı silerek alt satırlar yukarı doğru çıksın sevk edilen siparişler de ise tümü alt alta gelecek şekilde aktarım yapılabilirmi

 

[askm]

Silme olayını unutmuşum kusura bakmayın.

Sub askm()
Dim s1, s2 As Worksheet
Set s1 = Sheets("AÇIK SİPARİŞLER")
Set s2 = Sheets("SEVKEDİLEN SİPARİŞLER")
Dim Son1, Son2 As Long
Son1 = s1.Range("A" & Rows.Count).End(xlUp).Row
s2.Range("a2:AJ65000").ClearContents
For i = 2 To Son1
    If s1.Cells(i, "AJ") = "SEVK EDİLDİ" Then
        Son2 = s2.Range("A" & Rows.Count).End(xlUp).Row + 1
        s1.Range("A" & i & ":AJ" & i).Copy s2.Cells(Son2, "A")
        s1.Rows(i).Delete
        i = i - 1
    End If
Next
MsgBox "SEVK EDİLEN kayıtların aktarma  işlemi tamamlandı..." & Chr(10) & Chr(10) & "İyi çalışmalar...", vbInformation, "ASKM"
End Sub

 

[acetinnster]

değerli askm hocam elinize sağlık çok teşekkür ederim

 

[askm]

Rica ederim kolay gelsin.