kaydet düğmesi ile veri kaydetme

[hasaki]

Değerli ustalar Merhaba,

Ekteki örnek dosyada detaylarını anlattığım gibi bir makroya ihtiyacım var. bu kayıt işleminde bana yardımcı olmanızı rica ediyorum. diğer formüllemeleri ben yapabiliyor. ama burda takıldım.

Yardımlarınızı bekliyorum.

teşekkürler.
Kolay gelsin

 

[muygun]

Merhaba;
İsteğinizi tam olarak karşılamasada eki inceleyin.
İyi çalışmalar.

 

[Korhan Ayhan]

Merhaba,

Bende bir örnek hazırlamıştım. Alternatif olarak incelermisiniz.

Dosyada sarı renkli hücrelerde formüller vardır. Sağlıklı çalışması için silmeyiniz.

Uygunlanan kod;

Option Explicit
 
Sub KAYDET()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Onay As Byte, Satır As Long
    
    Onay = MsgBox("Kayıt işlemini yapmak istediğinize emin misiniz?", vbCritical + vbYesNo, "Dikkat !")
    If Onay = vbNo Then Exit Sub
    
    Set S1 = Sheets("kayıt ekranı")
    
    S1.Select
    
    If Range("D1") = "" And Range("D2") = "" And WorksheetFunction.CountA(Range("C9:C" & Rows.Count)) = 0 Then
        MsgBox "Kayıt işlemine devam edebilmeniz için gerekli alanlara bilgi girişi yapmalısınız !" & Chr(10) & _
        "İşleminiz iptal edilmiştir !", vbExclamation, "Uyarı !"
        Range("D2").Select
        Exit Sub
    End If
        
    Set S2 = Sheets(S1.Range("D3").Text)
    
    Satır = S2.Range("A" & Rows.Count).End(3).Row + 1
    
    S1.Range("A9:G" & S1.Cells(Rows.Count, "C").End(3).Row).Copy
    S2.Cells(Satır, 1).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
    S1.Range("D2:D3").ClearContents
    S1.Range("C9:G" & Rows.Count).ClearContents
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub

 

[hasaki]

çoook teşekkür ediyorum

ikinizinde yaptığı uygulama bir birinden güzel. çok teşekkür ediyorum. emeğinize elinize aklınıza sağlık.

 

[gokhan13]

merhaba ekli dosyamda b6 da yer alan ünvana göre ilgili dosyayı kaydet butonu ile kayıt edebilirmiyiz??

 

[kemal turan]

Üstadlar merhaba.
Ekteki çalışma süper olmuş .Kendi işime uyarlamaya çalıştım kodlamadan anlama noktasında işin alfabesinde olduğum için uyarlayamadım.Banada yardımcı olabilirseniz sevinirim.İsteklerimi ekte belirttim.
Teşekkürler

 

[kemal turan]

bir önceki ek dosya makroları bozulmuş.Yeni eke bir bakarsanız.
Tşk.

 

[kemal turan]

Sn.uzmanlarımızdan yardım bekliyorum.
Tşk.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu kullanabilirsiniz.

Sub Kaydet()
    Satır = Sheets("Satışlar").Cells(Rows.Count, 1).End(3).Row + 1
    Sheets("Satış Planlama").Range("N9:Al" & Sheets("Satış Planlama").Range("N31").End(3).Row).Copy
    Sheets("Satışlar").Cells(Satır, 1).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub