Soru Sütunda ki hücrede yazılı isme göre aktar

[sirkülasyon]

Sub Aktar()
    Dim cevap As String
    cevap = MsgBox("Personel sayfasındaki verileri Puantaj sayfasına aktarmak istediğinize emin misiniz?", vbYesNo + vbQuestion, "Veri Aktarımı")
    If cevap = vbYes Then
        Dim personelSayfa As Worksheet
        Dim puantajSayfa As Worksheet
        Dim i As Long
        Set personelSayfa = ThisWorkbook.Sheets("Personel")
        Set puantajSayfa = ThisWorkbook.Sheets("Puantaj")
        For i = 3 To 50
            puantajSayfa.Range("B" & i).Value = personelSayfa.Range("B" & i).Value
            puantajSayfa.Range("C" & i).Value = personelSayfa.Range("C" & i).Value
            puantajSayfa.Range("D" & i).Value = personelSayfa.Range("D" & i).Value
            puantajSayfa.Range("E" & i).Value = personelSayfa.Range("E" & i).Value
            puantajSayfa.Range("F" & i).Value = personelSayfa.Range("F" & i).Value
        Next i
        MsgBox "Veriler başarıyla aktarıldı!", vbInformation, "Bilgi"
    End If
End Sub

Yukarıdaki kod ile Personel sayfasını B3:B50 aralığını toplu olarak Puantaj sayfasına aktarabiliyorum.
Ancak; Personel sayfasında B3:F50 aralığı D350 de yazılı isimleri sorarak aktarrmak istiyorum.
Personel Sayfasında ki D3 hücresindeki "Ahmet MEHMET" isimli personele ödeme yapacak mısınız? EVET ise Personel Sayfasındaki B3:F3 aralığını PUANTAJ sayfası B3:F3 aralığına aktaracak. HAYIR ise bir sonraki satıra geçecek.
Aktarılacak veri kalmadı ise UYARI verecek.
Yardımcı olabilir misiniz? Saygılarımal

 

[alicimri]

Deneyin

Sub Aktar()
    Dim bak As String
        Dim personelSayfa As Worksheet
        Dim puantajSayfa As Worksheet
        Dim i As Long
        Set personelSayfa = ThisWorkbook.Sheets("Personel")
        Set puantajSayfa = ThisWorkbook.Sheets("Puantaj")
        For i = 3 To 50
 bak = MsgBox(Range("D" & i).Value & " isimli personele ödeme yapacak mısınız", vbYesNo, "SORU")
    If bak = 6 Then
            puantajSayfa.Range("B" & i & ":F" & i).Copy personelSayfa.Range("B" & personelSayfa.Cells(Rows.Count, 4).End(3).Row + 1)
          End If
        Next i
        MsgBox "Veriler başarıyla aktarıldı!", vbInformation, "Bilgi"
End Sub

 

[sirkülasyon]

Ali bey;
Teşekkür ederim lakin 1. personeli aktarma işlemine EVET onayını verildikten sonra aktaracak işlemi durduracak. Tekrar aktar butonuna basıldığında 2. personeli aktaracak işlemi durduracak. Sonraki, sonraki şeklinde dolu hücre sayısı kadar tekrar edecek.
HAYIR onayı verildi ise işlemi durdurmayacak bir sonraki satıra geçecek.
Allah razı olsun

 

[alicimri]

Sizin istediğiniz işlemler bayağı karışık. Çünkü Evet tıklayıp aktarma yapılıp çıkılacaksa, Hayır'a tıklayıp aradan seçim yapılıp yine Evet'e tıklayıp kayıt yapılacaksa Personel sayfasında ne kayıtlı ne kayıtsız karışır.
Siz msgbox yerine listbox kullanın.
Listboxda Personel sayfasında bulunmayan isimler listelensin aktarma yapıldıkça listboxdan silinsin.