CheckBox Seçili İse Başka Sayfaya Aktar

[ormann]

İyi günler ekteki dosyada aşağıda ki makroya ilave olarak CheckBox Seçili ise aktar butonuna bastığımda hücredeki sarı renkli alanlar "ÜRETİM" sayfasına aktarılabilir mi?.Seçili değilse yine aşağıdaki makro uygulanabilir mi?

Private Sub CommandButton1_Click()
Dim STR As Long, SR As Variant
Dim SYF As Worksheet
Set SYF = Sheets("SATIŞLAR")
SR = MsgBox(Range("e3") & " NOLU  İSTİF ""SATIŞ KAYIT DEFTERİNE AKTARILSIN MI ?""", vbYesNo, "SATIŞLAR")
If SR = vbNo Then Exit Sub
Application.ScreenUpdating = False
STR = SYF.Range("D" & Rows.Count).End(xlUp).Row + 1
SYF.Cells(STR, "D") = Range("E3")
SYF.Cells(STR, "E") = Range("E4")
SYF.Cells(STR, "F") = Range("E5")
SYF.Cells(STR, "G") = Range("E6")
SYF.Cells(STR, "H") = Range("E7")
SYF.Cells(STR, "I") = Range("E8")
SYF.Cells(STR, "J") = Range("E9")
SYF.Cells(STR, "K") = Range("E10")
SYF.Cells(STR, "L") = Range("E11")
SYF.Cells(STR, "M") = Range("E12")
SYF.Range("C7") = 1
SYF.Range("C7:C" & STR).DataSeries xlColumns, xlLinear, xlDay, 1, , False
Application.ScreenUpdating = True
MsgBox Range("E3") & "  NUMARALI SATIŞI YAPILAN İSTİF SATIŞ KAYIT DEFTERİNE AKTARILDI", vbInformation
End Sub

 

[vardar07]

Merhaba.
Yukarıdaki kodu Aşağıdaki gibi Denermisin

Private Sub CommandButton1_Click()
Dim STR As Long, SR As Variant
Dim SYF As Worksheet
If CheckBox1.Value = True Then
Set SYF = Sheets("SATIŞLAR")
SR = MsgBox(Range("e3") & " NOLU  İSTİF ""SATIŞ KAYIT DEFTERİNE AKTARILSIN MI ?""", vbYesNo, "SATIŞLAR")
If SR = vbNo Then Exit Sub
Application.ScreenUpdating = False
STR = SYF.Range("D" & Rows.Count).End(xlUp).Row + 1
SYF.Cells(STR, "D") = Range("E3")
SYF.Cells(STR, "E") = Range("E4")
SYF.Cells(STR, "F") = Range("E5")
SYF.Cells(STR, "G") = Range("E6")
SYF.Cells(STR, "H") = Range("E7")
SYF.Cells(STR, "I") = Range("E8")
SYF.Cells(STR, "J") = Range("E9")
SYF.Cells(STR, "K") = Range("E10")
SYF.Cells(STR, "L") = Range("E11")
SYF.Cells(STR, "M") = Range("E12")
SYF.Range("C7") = 1
SYF.Range("C7:C" & STR).DataSeries xlColumns, xlLinear, xlDay, 1, , False
Application.ScreenUpdating = True
MsgBox Range("E3") & "  NUMARALI SATIŞI YAPILAN İSTİF SATIŞ KAYIT DEFTERİNE AKTARILDI", vbInformation
Else
Set SYF = Sheets("ÜRETİM")
SR = MsgBox(Range("e3") & " NOLU  İSTİF ""ÜRETİM KAYIT DEFTERİNE AKTARILSIN MI ?""", vbYesNo, "SATIŞLAR")
If SR = vbNo Then Exit Sub
Application.ScreenUpdating = False
STR = SYF.Range("D" & Rows.Count).End(xlUp).Row + 1
SYF.Cells(STR, "D") = Range("E3")
SYF.Cells(STR, "E") = Range("E4")
SYF.Cells(STR, "F") = Range("E5")
SYF.Cells(STR, "G") = Range("E6")
SYF.Cells(STR, "H") = Range("E7")
SYF.Cells(STR, "I") = Range("E8")
SYF.Cells(STR, "J") = Range("E9")
SYF.Cells(STR, "K") = Range("E10")
SYF.Cells(STR, "L") = Range("E11")
SYF.Cells(STR, "M") = Range("E12")
SYF.Range("C7") = 1
SYF.Range("C7:C" & STR).DataSeries xlColumns, xlLinear, xlDay, 1, , False
Application.ScreenUpdating = True
MsgBox Range("E3") & "  NUMARALI SATIŞI YAPILAN İSTİF ÜRETİM KAYIT DEFTERİNE AKTARILDI", vbInformation
End If
End Sub