Sayfaya yazılan kodla hücreye ve sahifeye veri aktarma

[kemal turan]

Bir sahifede çift tıklama işle hücre verisini aktarmada ve verileri sahifelere aktarmada sorunum var.
Konu ile ilgili problemi ek'teki dosyada açıkladım.
Yardımlarınız için teşekkür ederim.

 

[kemal turan]

Merhaba üstadlar,
Sorumda bir hatam mı var, veya istediğim yapılamaz mı?
Teşekkür ederim.Kolay gelsin.

 

[mancubus]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Intersect(Target, Range("B48:D48")) Is Nothing Then Exit Sub

Select Case Target.Column
    Case Is = 2
        Range("C6").Value = Target.Value
    Case Is = 3
        Range("C7").Value = Target.Value
    Case Is = 4
        Range("C4").Value = Target.Value
End Select

End Sub

 

[kemal turan]

Sn.Mancubus ,
Çok teşekkür ederim.Verdiğiniz kod çok güzel çalıştı.
Diğer bir ihtiyacım daha vardı.
Şöyleki;
Verileri girdikten sonra "Siparişi gir" butonuna bastığımızda "siparişler"sahifesine kayıt yapıyor.
İstediğim aynı kaydı ilgili diğer ilgili sahifelerde kayıt etmesi.
Detay açıklama ek'dosyadadır.
Selametle kalın.
Çok teşekkür ederim.

 

[mancubus]

rica ederim.

-------------------------
bir çok forum takip ediyorum. genellikle cevap verenler, üstadlar şunu talep ediyorlar:
"soruları parça parça sormayın. ilk mesajda tüm ihtiyacı ortaya koyun. farklı durumlar, problemler ortaya çıktıkça elbette ilave mesajla devam edilir."

nedenini söylemeye gerek yok zannediyorum.

--------------------------

rutin veri girişi yapılacaksa UserForm kullanılması önerilir. forumda bir çok örnek olduğunu biliyorsunuz.

Worksheet_BeforeDoubleClick olayı ile seçtiğiniz verileri Combobox'a yükleyerek oradan seçilmesi sağlanabilir.

bu şekilde kullanılmaya devam edilecek ise "veri doğrulama" ile doğrudan hücrelede açılır listeden seçilmeleri daha uygun olacaktır.

-----------------------------

bunları söyledikten sonra, konuya dönersek, sizin ihtiyaca ben aşağıdaki gibi yaklaştım. çok farklı yöntemler ile de yapılabilir.

* A sütunlarını tarih olarak formatlamışsınız. bunu düzeltin.
* Sipariş No verisini ben kullanmıyorum. Sipariş Sayfasında Application.Max(.Columns(1)) + 1 ile 1'er artırıyorum.

Sub SiparisKaydet()

    Dim wsSip As Worksheet, wsKas As Worksheet
    Dim silinsin As Variant
    Dim Sat As Long
    
    Set wsSip = Worksheets("siparişler")
    Set wsKas = Worksheets("Kasar Sip.")
    
    With wsSip
        .AutoFilterMode = False
        Sat = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(Sat, 1).Value = Application.Max(.Columns(1)) + 1
        Range(.Cells(Sat, 2), .Cells(Sat, 10)).Value = _
            Application.Transpose(Range("C3:C11"))
    End With
    
    wsKas.Range("A" & Sat & ":J" & Sat).Value = _
        wsSip.Range("A" & Sat & ":J" & Sat).Value
    
    silinsin = MsgBox("Kayıt işlemi tamamlanmıştır." & vbCr & vbCr & _
        "KAYIT ALANI TEMİZLENSİN Mİ ?", vbYesNo, "AFEY TEKSTİL")
    If silinsin = vbYes Then
        ActiveSheet.Range("C5:C11").ClearContents
        MsgBox "YENİ KAYIT GİREBİLİRSİNİZ", , "AFEY TEKSTİL"
        Range("C4").Select
    End If
    
End Sub

 

[kemal turan]

Sn.Mancubus,
Öncelikle açıklamalarınız ve çözümünüz için çok teşekkür ederim.
Doğru söylüyorsunuz soruların bir bütünlük içerisinde sorulması çözüme katkı sağlar.
Bende o doğrultuda ilk sorumda gönderdiğim dosyada bunu belirtmiş idim.
Verdiğiniz kod çalışıyor.Bir eksiklik vardı ilave etmeye çalıştım başaramadım.
Şöyleki;
Girilen kayıtlar "sipariş kayıt gir" butonuna basıldığında standart olarak "Siparişler" sahifesine kayıt olacak.
Bunun yanında işlem türü hücresi "C7";
"Boyama" ise "Boyama sip."sahifesine
"Kasar" ise "Kasar sip."sahifesine
"Şardon" ise "Şardon sip."sahifesine
"Yıkama" ise "Yıkama sip."sahifesine
Kayıt olacak.Diğer bir deyişle her sipariş kaydı 2 sahifeye kayıt olacak, burda siparişler sahifesi standart kayıt alacak.
Çok teşekkür ederim.Selametle Kalın.

 

[mancubus]

takip ettiğim forumlardan öğrendiğim hususlardan biri de cevap verme gayreti içine girenin sorulan soruyu iyi okuması ve anlayarak cevap vermesidir.

golü yedim
ama maç devam ediyor... :biggrin:

varsayım:
verilerin kopyalanacağı sayfa isimleri işlem türününün YAZIM.DÜZENİ'ne (PROPER) " Sip." ifadesinin eklenmesi ile oluşmaktadır.

    Dim wsSip As Worksheet, wsAktar As Worksheet
    Dim silinsin As Variant
    Dim Sat As Long
    Dim Sayfa As String

    Set wsSip = Worksheets("siparişler")

    With wsSip
        .AutoFilterMode = False
        Sayfa = StrConv(Range("C7").Text, vbProperCase) & " Sip."
        'Sayfa = Application.Proper(Range("C7").Text) & " Sip." 'yukarıdaki işlem ile aynı sonucu verir. 
        Set wsAktar = Worksheets(Sayfa)
        Sat = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(Sat, 1).Value = Application.Max(.Columns(1)) + 1
        Range(.Cells(Sat, 2), .Cells(Sat, 10)).Value = _
            Application.Transpose(Range("C3:C11"))
    End With

    wsAktar.Range("A" & Sat & ":J" & Sat).Value = _
        wsSip.Range("A" & Sat & ":J" & Sat).Value

    silinsin = MsgBox("Kayıt işlemi tamamlanmıştır." & vbCr & vbCr & _
        "KAYIT ALANI TEMİZLENSİN Mİ ?", vbYesNo, "AFEY TEKSTİL")
    If silinsin = vbYes Then
        ActiveSheet.Range("C5:C11").ClearContents
        MsgBox "YENİ KAYIT GİREBİLİRSİNİZ", , "AFEY TEKSTİL"
        Range("C4").Select
    End If

 

[kemal turan]

Sn.Mancubus,
Kodlar hususunda kafamı verdiğimde yaşımdan olsa gerek işlemcim kitleniyor.
Worksheets olarak verdiğiniz yukarıdaki sipariş kaydet kodu modül1 e yapıştırdım. bu sefer çift tıklama işi arıza yaptı.
Şu an eklemiş olduğum sayfada herşey istediğim gibi.
Mevcut dosyaya bir baksanızda onun üstünde çözüme gitsek çok memnun olurum.Yine detay açıklamaları yaptım.
Emeğinize sağlık.

 

[mancubus]

1- işlem türü ve sayfa ismini aynı hale getirmek için sayfa isimlerindeki " Sip." ibarelerini silerek tamamiyle sayfadaki gibi büyük harf yaptım.
2- sipariş noyu makro ile değil formül ile girmeyi tercih ettiğin için hesaplama otomatik olarak seçilmelidir.

Sub SiparisKaydet()

    Dim wsSip As Worksheet, wsAktar As Worksheet
    Dim silinsin As Variant
    Dim SipSat As Long, AktSat As Long
    Dim SayfaAdi As String

    Set wsSip = Worksheets("siparişler")
    With wsSip
        .AutoFilterMode = False
        SipSat = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        Range(.Cells(SipSat, 1), .Cells(SipSat, 10)).Value = _
            Application.Transpose(Range("C2:C11"))
    End With
    
    SayfaAdi = Range("C7").Text
    Set wsAktar = Worksheets(SayfaAdi)
    With wsAktar
        AktSat = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Range("A" & AktSat & ":J" & AktSat).Value = _
            wsSip.Range("A" & SipSat & ":J" & SipSat).Value
    End With

    silinsin = MsgBox("Kayıt işlemi tamamlanmıştır." & vbCr & vbCr & _
        "KAYIT ALANI TEMİZLENSİN Mİ ?", vbYesNo, "AFEY TEKSTİL")
    If silinsin = vbYes Then
        ActiveSheet.Range("C5:C11").ClearContents
        MsgBox "YENİ KAYIT GİREBİLİRSİNİZ", , "AFEY TEKSTİL"
        Range("C4").Select
    End If

End Sub

 

[kemal turan]

Sn.Mancubus,
Ellerinize, emeğinize sağlık, harcadığınız zamanı helel edin.
Süper bir fason siğariş kayıt ve takip proğramı oldu sayenizde.
Selametle kalın..

 

[mancubus]

rica ederim.

yardımcı olabildi isek ne mutlu.

kolay gelsin.