Kayıt Makrosu Yardım...!!!!

[SER973]

Merhabalar;

Forumda Kayıt makrosu ile ilgili birçok örnek var fakat benim istediğim şekilde bir kayıt makrosu örneği bulamadım. Benim Örnek tablom ektedir. Yapmak istediği dosya içine yazdım yardımlarınız için şimdiden teşekkürler...

 

[Orion1]

Ekli dosyayı inceleyiniz.

Sub data_aktar()
Dim sat As Long
Sheets("Form").Select
Set s2 = Sheets("Data")
sat = s2.Cells(65536, "A").End(xlUp).Row + 1
If Range("B9").Value <> "" Or Range("B15").Value <> "" Then
    s2.Cells(sat, "F").Value = Range("A9").Value
    s2.Cells(sat, "G").Value = Range("B9").Value
    s2.Cells(sat, "H").Value = Range("B15").Value
    GoSub kayit
    sat = sat + 1
End If
If Range("B10").Value <> "" Or Range("B16") <> "" Then
    s2.Cells(sat, "F").Value = Range("A10").Value
    s2.Cells(sat, "G").Value = Range("B10").Value
    s2.Cells(sat, "H").Value = Range("B16").Value
    GoSub kayit
    sat = sat + 1
End If
If Range("B11").Value <> "" Or Range("B17").Value <> "" Then
    s2.Cells(sat, "F").Value = Range("A11").Value
    s2.Cells(sat, "G").Value = Range("B11").Value
    s2.Cells(sat, "H").Value = Range("B17").Value
    GoSub kayit
    sat = sat + 1
End If
If Range("B12").Value <> "" Or Range("B18").Value <> "" Then
    s2.Cells(sat, "F").Value = Range("A12").Value
    s2.Cells(sat, "G").Value = Range("B12").Value
    s2.Cells(sat, "H").Value = Range("B18").Value
    GoSub kayit
End If
Set s2 = Nothing
MsgBox "Kayıt Data Sayfasına Aktarıldı..!!", vbOKOnly + vbInformation, "KAYIT"
Exit Sub
kayit:
s2.Cells(sat, "A").Value = Range("B2").Value
s2.Cells(sat, "B").Value = Range("B3").Value
s2.Cells(sat, "C").Value = Range("B4").Value
s2.Cells(sat, "D").Value = Range("B5").Value
s2.Cells(sat, "E").Value = Range("B6").Value
Return
End Sub

 

[SER973]

Sn Orion 2

Elinize Sağlık Çok Teşekkür Ederim..