şartlı veri aktarımı

[arifbirgen]

Değerli hocalarım
örnekte veri aktarılıyor fakat sayfa1 de seçilen
numaralı satırları sayfa2 de aynı eş numaraya
aktarmak istiyorum.Yardımcı olursanız sevinirim.

 

[Orion1]

Dosyanız ekte.

Sub aktar_sil()
Dim k As Range, i As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
With Sheets("Sayfa2")
    For i = Cells(65536, "A").End(xlUp).Row To 5 Step -1
        If Cells(i, "A").Value <> "" Then
            Set k = .Range("A8:A65536").Find(Cells(i, "A").Value, , xlValues, xlWhole)
            If Not k Is Nothing Then
                .Range("B" & k.Row & ":D" & k.Row).Value = Range("B" & i & ":D" & i).Value
                Range("A" & i & ":D" & i).Delete (xlUp)
            End If
        End If
    Next i
End With
Application.ScreenUpdating = True
MsgBox "Aktarım tamalandı"
        

End Sub

 

[arifbirgen]

Sn.Evren GİZLEN hocam

Ellerine,beynine sağlık.Çook teşekkür ederim.

 

[Orion1]

Sn.Evren GİZLEN hocam

Ellerine,beynine sağlık.Çook teşekkür ederim.

Rica ederim.
İyi çalışmalar.