Sayfa 1 ile 2 arasında veri transferi-2 ?

[Gorarr]

Daha önceki bir sorumdu İhsan Tank ustamız yardımcı olmuştu.

Olay şu sayfa1 deki bir sütundan yandaki isimlere uygun şekilde sayfa2 ye taşıma yapıyor. Ben bu kodlara ek olarak. bu taşıma olan satırlar sayfa1 den silinsin istiyorum. örnek dosyamda biraz daha net açıklayabildim.

Yardımlarınız için şimdiden çok teşekkürler...

 

[Ergün Güler]

Daha önceki bir sorumdu İhsan Tank ustamız yardımcı olmuştu.

Olay şu sayfa1 deki bir sütundan yandaki isimlere uygun şekilde sayfa2 ye taşıma yapıyor. Ben bu kodlara ek olarak. bu taşıma olan satırlar sayfa1 den silinsin istiyorum. örnek dosyamda biraz daha net açıklayabildim.

Yardımlarınız için şimdiden çok teşekkürler...

Selam,

Satırı mı silmek istiyorsunuz Yoksa hücreleri mi temizlemek istiyorsunuz?

Her ikisi için kodlar aşağıdaki gibidir.

Sub aktarım()
Dim aranan As Range
Dim bulunan As Range
Dim i As Long
Dim syf_son As Long
Dim s1 As Worksheet
Dim syf As Worksheet

Set s1 = ThisWorkbook.Worksheets("Sayfa1")
Set syf = ThisWorkbook.Worksheets("Sayfa2")

syf_son = syf.Cells(65536, "B").End(3).Row

For i = 2 To syf_son
Set aranan = syf.Cells(i, "B")
Set bulunan = s1.Range("B2:B65536").Find(aranan.Value, , xlValues, xlWhole)

If Not bulunan Is Nothing Then
syf.Cells(aranan.Row, "C") = s1.Cells(bulunan.Row, "C")
s1.Rows(bulunan.Row).Delete Shift:=xlUp 'Satırı siler
's1.Range(s1.Cells(bulunan.Row, "A"), s1.Cells(bulunan.Row, "C")).ClearContents 'Hücreleri temizler
End If

Next

MsgBox "Kodlar Taşındı ve Taşınanlar Silindi.", vbInformation

End Sub

İyi çalışmalar.

 

[Gorarr]

Çok çok teşekkürler. Tam istediğim gibi ellerinize sağlık..

 

[Ergün Güler]

Çok çok teşekkürler. Tam istediğim gibi ellerinize sağlık..

Selam,
Ben teşekkür ederim.
İyi çalışmalar