hücre doluysa yan hücreye veri kopyalama

[tkcargo]

merhaba,
ekte ornek dosyada açıklamaya çalıştım yardımcı olursanız sevinirim. teşekkürler

 

[Yitik]

Merhaba saat malum deneyemedim, olması lazım. İyi çalışmalar.

Sub aktar()
a = Worksheets("Sayfa1").Range("r12").Value
Set bul = Worksheets("Sayfa2").Range("c4:c" & Range("c65536").End(3).Row).Find(a, , , 1)
If Not bul Is Nothing Then
    b = bul.Row
        If Worksheets("Sayfa2").Range("w" & b).Value = Empty And Worksheets("Sayfa2").Range("x" & b).Value = Empty Then
            Worksheets("Sayfa2").Range("w" & b).Value = Worksheets("Sayfa1").Range("k9").Value
            Worksheets("Sayfa2").Range("x" & b).Value = Worksheets("Sayfa1").Range("k10").Value
        ElseIf Worksheets("Sayfa2").Range("z" & b).Value = Empty And Worksheets("Sayfa2").Range("aa" & b).Value = Empty Then
            Worksheets("Sayfa2").Range("z" & b).Value = Worksheets("Sayfa1").Range("k9").Value
            Worksheets("Sayfa2").Range("aa" & b).Value = Worksheets("Sayfa1").Range("k10").Value
        ElseIf Worksheets("Sayfa2").Range("ac" & b).Value = Empty And Worksheets("Sayfa2").Range("ad" & b).Value = Empty Then
            Worksheets("Sayfa2").Range("ac" & b).Value = Worksheets("Sayfa1").Range("k9").Value
            Worksheets("Sayfa2").Range("ad" & b).Value = Worksheets("Sayfa1").Range("k10").Value
        End If
ElseIf bul Is Nothing Then
MsgBox " ARADIĞINIZ SİCİL NO BULUNAMADI"
Exit Sub
End If
MsgBox " KAYITLAR AKTARILDI"
Worksheets("Sayfa2").Select
End Sub

 

[tkcargo]

Merhaba saat malum deneyemedim, olması lazım. İyi çalışmalar.

Sub aktar()
a = Worksheets("Sayfa1").Range("r12").Value
Set bul = Worksheets("Sayfa2").Range("c4:c" & Range("c65536").End(3).Row).Find(a, , , 1)
If Not bul Is Nothing Then
    b = bul.Row
        If Worksheets("Sayfa2").Range("w" & b).Value = Empty And Worksheets("Sayfa2").Range("x" & b).Value = Empty Then
            Worksheets("Sayfa2").Range("w" & b).Value = Worksheets("Sayfa1").Range("k9").Value
            Worksheets("Sayfa2").Range("x" & b).Value = Worksheets("Sayfa1").Range("k10").Value
        ElseIf Worksheets("Sayfa2").Range("z" & b).Value = Empty And Worksheets("Sayfa2").Range("aa" & b).Value = Empty Then
            Worksheets("Sayfa2").Range("z" & b).Value = Worksheets("Sayfa1").Range("k9").Value
            Worksheets("Sayfa2").Range("aa" & b).Value = Worksheets("Sayfa1").Range("k10").Value
        ElseIf Worksheets("Sayfa2").Range("ac" & b).Value = Empty And Worksheets("Sayfa2").Range("ad" & b).Value = Empty Then
            Worksheets("Sayfa2").Range("ac" & b).Value = Worksheets("Sayfa1").Range("k9").Value
            Worksheets("Sayfa2").Range("ad" & b).Value = Worksheets("Sayfa1").Range("k10").Value
        End If
ElseIf bul Is Nothing Then
MsgBox " ARADIĞINIZ SİCİL NO BULUNAMADI"
Exit Sub
End If
MsgBox " KAYITLAR AKTARILDI"
Worksheets("Sayfa2").Select
End Sub

çok teşekkürler kod çalıştı