Kaydet Butonu

[akyyuc]

Merhaba,
Kaydet butonu ile;
Sub kaydet()
Dim S1 As Worksheet, S2 As Worksheet, STR As Long
Set S1 = Sheets("METRAJ GİRİŞLERİ (2)")
Set S2 = Sheets("Sayfa1")
STR = S2.Range("F" & Rows.Count).End(xlUp).Row + 1
If STR <= 4 Then
STR = 5
End If
S2.Range("F" & STR) = S1.Range("K5")
S2.Range("G" & STR) = S1.Range("M3")
S2.Range("H" & STR) = S1.Range("O3")
S2.Range("I" & STR) = S1.Range("M8")
S2.Range("J" & STR) = S1.Range("N8")
S2.Range("K" & STR) = S1.Range("O8")
S2.Range("L" & STR) = S1.Range("P8")
S2.Range("M" & STR) = S1.Range("Q8")
S2.Range("N" & STR) = S1.Range("R8")
S2.Range("O" & STR) = S1.Range("K11")
S2.Range("P" & STR) = S1.Range("M11")
S2.Range("Q" & STR) = S1.Range("N11")
S2.Range("R" & STR) = S1.Range("O11")
S2.Range("S" & STR) = S1.Range("P11")
S2.Range("T" & STR) = S1.Range("Q11")
S2.Range("U" & STR) = S1.Range("R11")
S2.Range("V" & STR) = S1.Range("K12")
S2.Range("W" & STR) = S1.Range("M12")
S2.Range("X" & STR) = S1.Range("N12")
S2.Range("Y" & STR) = S1.Range("O12")
S2.Range("Z" & STR) = S1.Range("P12")
S2.Range("AA" & STR) = S1.Range("Q12")
S2.Range("AB" & STR) = S1.Range("R12")
S2.Range("AC" & STR) = S1.Range("K13")
S2.Range("AD" & STR) = S1.Range("M13")
S2.Range("AE" & STR) = S1.Range("N13")
S2.Range("AF" & STR) = S1.Range("O13")
S2.Range("AG" & STR) = S1.Range("P13")
S2.Range("AH" & STR) = S1.Range("Q13")
S2.Range("AI" & STR) = S1.Range("R13")
S2.Range("AJ" & STR) = S1.Range("K14")
S2.Range("AK" & STR) = S1.Range("M14")
S2.Range("AL" & STR) = S1.Range("N14")
S2.Range("AM" & STR) = S1.Range("O14")
S2.Range("AN" & STR) = S1.Range("P14")
S2.Range("AO" & STR) = S1.Range("Q14")
S2.Range("AP" & STR) = S1.Range("R14")
S2.Range("AQ" & STR) = S1.Range("K15")
S2.Range("AR" & STR) = S1.Range("M15")
S2.Range("AS" & STR) = S1.Range("N15")
S2.Range("AT" & STR) = S1.Range("O15")
S2.Range("AU" & STR) = S1.Range("P15")
S2.Range("AV" & STR) = S1.Range("Q15")
S2.Range("AW" & STR) = S1.Range("R15")
S2.Range("AX" & STR) = S1.Range("K16")
S2.Range("AY" & STR) = S1.Range("M16")
S2.Range("AZ" & STR) = S1.Range("N16")
S2.Range("BA" & STR) = S1.Range("O16")
S2.Range("BB" & STR) = S1.Range("P16")
S2.Range("BC" & STR) = S1.Range("Q16")
S2.Range("BD" & STR) = S1.Range("R16")
S2.Range("BE" & STR) = S1.Range("K17")
S2.Range("BF" & STR) = S1.Range("M17")
S2.Range("BG" & STR) = S1.Range("N17")
S2.Range("BH" & STR) = S1.Range("O17")
S2.Range("BI" & STR) = S1.Range("P17")
S2.Range("BJ" & STR) = S1.Range("Q17")
S2.Range("BK" & STR) = S1.Range("R17")
S2.Range("BL" & STR) = S1.Range("K18")
S2.Range("BM" & STR) = S1.Range("M18")
S2.Range("BN" & STR) = S1.Range("N18")
S2.Range("BO" & STR) = S1.Range("O18")
S2.Range("BP" & STR) = S1.Range("P18")
S2.Range("BQ" & STR) = S1.Range("Q18")
S2.Range("BR" & STR) = S1.Range("R18")
S2.Range("BS" & STR) = S1.Range("K19")
S2.Range("BT" & STR) = S1.Range("M19")
S2.Range("BU" & STR) = S1.Range("N19")
S2.Range("BV" & STR) = S1.Range("O19")
S2.Range("BW" & STR) = S1.Range("P19")
S2.Range("BX" & STR) = S1.Range("Q19")
S2.Range("BY" & STR) = S1.Range("R19")
MsgBox "İşlem Tamamlandı"
End Sub

işlemi gerçekleşiyor.
Ancak ben, kaydet butonunu tıkladığımda, bu işlemle birlikte aynı anda S1 de bulunan hücrelerin silinip yeni veri girişine hazır olmasını ve yine aynı anda Sayfa3 "A1" hücresine gitmiş olmayı istiyorum.

Mümkünse yardımınızı rica ederim...
İyi çalışmalar...

 

[ÖmerBey]

Merhaba,
Kodunuzun sonuna aşağıdaki satırları ilave ediniz...

S1.Range("K5,M3,O3,M8:R8,K11:R19").ClearContents
Sheets("Sayfa3").Activate
Sheets("Sayfa3").Range("A1").Select

 

[uzmanamele]

Merhaba

Mevcut kodların sonuna ekleyerek deneyiniz.

S1.Select
Cells.Select
Selection.ClearContents

Sheets("sayfa3").Select
Range("a1").Select

 

[akyyuc]

Teşekkür ederim... Ama beceremedim

 

[akyyuc]

Merhaba,
Kodunuzun sonuna aşağıdaki satırları ilave ediniz...

S1.Range("K5,M3,O3,M8:R8,K11:R19").ClearContents
Sheets("Sayfa3").Activate
Sheets("Sayfa3").Range("A1").Select

Teşekkür ederim ama beceremedim

 

[ÖmerBey]

Teşekkür ederim... Ama beceremedim

Kullandığınız kodun son kısmına yukarıdaki kodlardan birini ilave ediniz...

S2.Range("BW" & Str) = S1.Range("P19")
S2.Range("BX" & Str) = S1.Range("Q19")
S2.Range("BY" & Str) = S1.Range("R19")
[COLOR="Red"]S1.Range("K5,M3,O3,M8:R8,K11:R19").ClearContents
Sheets("Sayfa3").Activate
Sheets("Sayfa3").Range("A1").Select[/COLOR]
MsgBox "İşlem Tamamlandı"
End Sub

 

[akyyuc]

Kullandığınız kodun son kısmına yukarıdaki kodlardan birini ilave ediniz...

S2.Range("BW" & Str) = S1.Range("P19")
S2.Range("BX" & Str) = S1.Range("Q19")
S2.Range("BY" & Str) = S1.Range("R19")
[COLOR="Red"]S1.Range("K5,M3,O3,M8:R8,K11:R19").ClearContents
Sheets("Sayfa3").Activate
Sheets("Sayfa3").Range("A1").Select[/COLOR]
MsgBox "İşlem Tamamlandı"
End Sub

Çok teşekkürler...