iki sayfa arasinda veri transferi

[yNsr43]

merhaba arkadaşlar sayfa1 deki verileri sayfa2 deki karışsık sıralanmiş verilere aktarmak istiyorum eğer veri yoksa oluştursun istiyorum.
kopyalanacak hücreler sabit olduğunda aktarabiliyorum ama böyle değişken olduğunda işin içinden çıkamadim nasıl bir yol kullanabiliriz teşekkürler.
https://www.dosyaupload.com/jaeq

bu kodu kullanıp yapabilirmiyiz

Sub makro()
Dim sh As Worksheet, sonsat As Long
Dim k As Range
Sheets("Sayfa1").Select
Set sh = Sheets("Sayfa2")
sonsat = sh.Cells(Rows.Count, "A").End(xlUp).Row
Set k = sh.Range("A1:A" & sonsat).Find(Range("A4").Value, , xlValues, xlWhole)
If k Is Nothing Then
sh.Range("A" & sonsat + 1) = Sheets("Sayfa3").Range("A4").Value
End If

If Not k Is Nothing Then
    k.Offset(0, 1).Value = Range("B6").Select.Value

End If
End Sub

 

[Orion1]

Buyurun.

Sub aktar_59()
Dim sh As Worksheet, sonsat1 As Long, sonsat2 As Long, k As Range
Dim i As Long
Sheets("Sayfa2").Select
Set sh = Sheets("Sayfa1")
sonsat1 = sh.Cells(Rows.Count, "A").End(xlUp).Row
sonsat2 = Cells(Rows.Count, "A").End(xlUp).Row
Range("B1:S" & Rows.Count).ClearContents
Application.ScreenUpdating = False
For i = 1 To sonsat2
    Set k = sh.Range("A1:A" & sonsat1).Find(Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then sh.Range("B" & k.Row & ":S" & k.Row).Copy Cells(i, "B")
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı."
End Sub

 

[yNsr43]

çok teşekkür ederim hocam
sayfa1de olup sayfa2 de olmayan mehmetleride aktarabilirmiyiz.

 

[Orion1]

çok teşekkür ederim hocam
sayfa1de olup sayfa2 de olmayan mehmetleride aktarabilirmiyiz.

Buyurun.

Sub aktar_59()
Dim sh As Worksheet, sonsat1 As Long, sonsat2 As Long, k As Range
Dim i As Long, sat As Long
Sheets("Sayfa2").Select
Set sh = Sheets("Sayfa1")
sonsat1 = sh.Cells(Rows.Count, "A").End(xlUp).Row
sonsat2 = Cells(Rows.Count, "A").End(xlUp).Row
Range("B1:S" & Rows.Count).ClearContents
Application.ScreenUpdating = False
For i = 1 To sonsat2
    Set k = sh.Range("A1:A" & sonsat1).Find(Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then sh.Range("B" & k.Row & ":S" & k.Row).Copy Cells(i, "B")
Next i
sat = Cells(Rows.Count, "A").End(xlUp).Row + 1
For i = 1 To sonsat1
    If Left(sh.Cells(i, "A").Value, 6) = "mehmet" Then
        Set k = Range("A1:A" & sonsat2).Find(sh.Cells(i, "A").Value, , xlValues, xlWhole)
        If k Is Nothing Then sh.Range("A" & i & ":S" & i).Copy Cells(sat, "A"): sat = sat + 1
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı."
End Sub

 

[yNsr43]

çok teşekkür ederim hocam
mehmetten ziyade sayfa1'e sayfa2 de olmayan yeni bir kişinin verileri girildiğinde onuda aktarabilir mi

 

[Orion1]

Bunun için userform hazırlayın.
Userformdan verileri girin.

 

[yNsr43]

teşekkür ederim hocam.

 

[Orion1]

Sayfadada veri girilecek tablo hazırlayabilirsiniz.
Birde buton koyarsınız verileri butona basınca kaydedersiniz.