DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub CommandButton1_Click()
Dim ws1 As Worksheet, a
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("Ana Sayfa")
Set s2 = ThisWorkbook.Worksheets("Kayıt")
If s1.Range("G14") = "" Then 'Aranan Değer
MsgBox "Parti Nosunu Yazmadan Kayıt Yapılamaz Lütfen Parti Nosunu Yazınız..." ', vbCritical
Exit Sub
End If
'///////////////////////////////////////////////////////////
a = MsgBox(" Bu Veriyi Kayıt Sayfasına Göndermek İstiyormusunuz?", vbYesNo + vbInformation, " Kayıt Sayfasına ")
If a = vbNo Then
Exit Sub
End If
'///////////////////////////////////////////////////////////
sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 2) = sonsatir - 6
s2.Cells(sonsatir, 3) = sonsatir - 7
s2.Cells(sonsatir, 3) = s1.Cells(14, "G")
s2.Cells(sonsatir, 4) = s1.Cells(14, "I")
s2.Cells(sonsatir, 5) = s1.Cells(9, "G")
s2.Cells(sonsatir, 6) = s1.Cells(7, "N")
s2.Cells(sonsatir, 7) = s1.Cells(8, "N")
s2.Cells(sonsatir, 8) = s1.Cells(9, "N")
s2.Cells(sonsatir, 9) = s1.Cells(10, "N")
s2.Cells(sonsatir, 10) = s1.Cells(11, "N")
s2.Cells(sonsatir, 11) = s1.Cells(12, "N")
s2.Cells(sonsatir, 12) = s1.Cells(13, "N")
s2.Cells(sonsatir, 13) = s1.Cells(14, "N")
s2.Cells(sonsatir, 14) = s1.Cells(15, "N")
'Range("G9,G14,I14").Select
Selection.ClearContents
Application.ScreenUpdating = True
Sheets("Kayıt").Select
Range("A1").Select
MsgBox "Verileriniz Kayıt Sayfasına Aktarılmıştır.", vbInformation
ActiveWorkbook.Save
'Application.Quit
End Sub