Hücreden Dataya Veri Aktarma (Makro)

[Lokmanx]

Merhaba ,

Ekte yer alan dosyada 10 tane alan var Veri işleme alanı isimli sayfada.

Bu alanlara veri yazdığımda Depolama alanı sayfasına verileri Alan1 - Alan2 yazan sıraya göre kaydetmesini istiyorum.

Bu konuda destek olabilir misiniz?

İyi çalışmalar

 

[Lokmanx]

Yardımcı olabilecek kimse yok mu acaba

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Aktar()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Son As Long, Nesne As Shape
    
    Set S1 = Sheets("Veri İşleme Alanı")
    Set S2 = Sheets("Depolama Alanı")
    
    Son = S2.Cells(S2.Rows.Count, 2).End(3).Row + 1
    
    For Each Nesne In S1.Shapes
        If InStr(1, Nesne.Name, "TextBox") > 0 Then
            S2.Cells(Son, Val(Replace(Nesne.Name, "TextBox", "")) + 1) = Nesne.DrawingObject.Object.Value
            Nesne.DrawingObject.Object.Value = ""
        End If
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub

 

[veyselemre]

Veri İşleme sayfanızın kod kısmına yapıştırın.

Private Sub ToggleButton1_Click()
    Set s2 = Sheets("Depolama Alanı")
    sat = s2.Cells(Rows.Count, 2).End(3).Row + 1
    
    For i = 1 To 10
        s2.Cells(sat, i + 1).Value = ActiveSheet.OLEObjects("Textbox" & i).Object.Text
        
        'Aşağıdaki satır textboxları temizler.
        ActiveSheet.OLEObjects("Textbox" & i).Object.Text = ""
    Next i
End Sub

 

[Lokmanx]

Korhan Bey teşekkür ederim.

Ancak bir soru işareti daha çıktı şimdi. Normalde bilgisayarda tab tuşu ile aşağıdaki hücreye inebiliyoruz burada o gerçekleşmiyor.

Bunun için bir çözüm var mı acaba

 

[Korhan Ayhan]

Siz zor olan yöntemi tercih etmişsiniz. Bu işlem için "Form Controls" nesneleri kullanmışsınız. Bence excel sayfası üzerinden işlem yapacaksanız excel hücrelerini kullanmayı tercih edebilirsiniz. Yönetmesi daha pratik ve kolay olur.

Yok ben bu şekilde nesneler kullanmak istiyorum diyorsanız o zaman UserForm konularını incelemenizi tavsiye ederim.

 

[Lokmanx]

Merhaba ,

Ekte Veri girişi isimli sayfaya veri girdiğimde ve verileri kaydet butonuna bastığımda verileri konu sırasına göre Data isimli sayfaya aktarmasını istiyorum.

Hergün yüzlerce verişi girişi olabiliyor ve data isimli sayfaya sıra bozulmadan veri girişi oldukça alt alta kaydetmesi mümkün mü acaba

Bu konuda yardımcı olabilir misiniz.

İyi çalışmalar

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Verileri_Kaydet()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
   
    Set S1 = Sheets("Veri Giriş")
    Set S2 = Sheets("Data")
   
    Son = S2.Cells(S2.Rows.Count, 2).End(3).Row + 1
   
    S2.Cells(Son, "B") = S1.Range("B2").Value
    S2.Cells(Son, "C") = S1.Range("B4").Value
    S2.Cells(Son, "D") = S1.Range("B6").Value
    S2.Cells(Son, "E") = S1.Range("B8").Value
    S2.Cells(Son, "F") = S1.Range("B10").Value
    S2.Cells(Son, "G") = S1.Range("B12").Value
    S2.Cells(Son, "H") = S1.Range("B14").Value
    S2.Cells(Son, "I") = S1.Range("B16").Value
    S2.Cells(Son, "J") = S1.Range("B18").Value
    S2.Cells(Son, "K") = S1.Range("B20").Value
    S2.Cells(Son, "L") = S1.Range("B22").Value
    S2.Cells(Son, "M") = S1.Range("G2").Value
    S2.Cells(Son, "N") = S1.Range("G4").Value
    S2.Cells(Son, "O") = S1.Range("G6").Value
    S2.Cells(Son, "P") = S1.Range("G8").Value
    S2.Cells(Son, "Q") = S1.Range("G10").Value
    S2.Cells(Son, "R") = S1.Range("G12").Value
    S2.Cells(Son, "S") = S1.Range("G14").Value
    S2.Cells(Son, "T") = S1.Range("G16").Value
    S2.Cells(Son, "U") = S1.Range("G18").Value
    S2.Cells(Son, "V") = S1.Range("G20").Value
    S2.Cells(Son, "W") = S1.Range("G22").Value
    S2.Cells(Son, "X") = S1.Range("L2").Value
    S2.Cells(Son, "Y") = S1.Range("L4").Value
    S2.Cells(Son, "Z") = S1.Range("L6").Value
    S2.Cells(Son, "AA") = S1.Range("L8").Value
    S2.Cells(Son, "AB") = S1.Range("L10").Value
    S2.Cells(Son, "AC") = S1.Range("L12").Value
    S2.Cells(Son, "AD") = S1.Range("L14").Value
    S2.Cells(Son, "AE") = S1.Range("L16").Value
    S2.Cells(Son, "AF") = S1.Range("L18").Value
    S2.Cells(Son, "AG") = S1.Range("L20").Value
    S2.Cells(Son, "AH") = S1.Range("L22").Value

    S1.Range("B2:C22").ClearContents
    S1.Range("G2:H22").ClearContents
    S1.Range("L2:M22").ClearContents

    Set S1 = Nothing
    Set S2 = Nothing

    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub

 

[Lokmanx]

Teşekkür Ederim Korhan Bey.

İyi çalışmalar

 

[veyselemre]

Sub test()
    
    Dim lRow&, fCol%, cl%, rw%
    lRow = Sheets("Data").Cells(Rows.Count, 2).End(3).Row + 1
    
    For cl = 4 To 14 Step 5
        fCol = (((cl + 1) / 5) - 1) * 11 + 1
        For rw = 2 To 22 Step 2
            Sheets("Data").Cells(lRow, fCol + (rw / 2)).Value = Sheets("Veri Giriş").Cells(rw, cl).Value
        Next rw
    Next cl
    
    Sheets("Veri Giriş").Range("D2:E22,I2:J22,N2:O22").ClearContents
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
    
End Sub

 

[Lokmanx]

Merhaba ,

Ekte açılır pencere ile kayıt ekranı var. Ancak verileri kaydet butonunu aktifleştiremedim.

Açılır pencereye kaydettiğim verilerin otomatik data sayfasına alt alta kaydetmesi için yardımcı olabilir misiniz

İyi çalışmalar

 

[Korhan Ayhan]

Önce Userform üzerindeki TextBox nesnelerini numerik olarak sıralı şekilde düzenleyin. Nasıl yapacağım derseniz. Formu kod editöründe açtığınızda TextBox2 nesnesinden sonra TextBox4 geliyor. Bunu sıralı olacak şekilde düzenlemelisiniz.

Sonra aşağıdaki kodu problemsiz kullanabilirsiniz.

Private Sub CommandButton1_Click()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Son As Long, X As Byte
    
    Set S1 = Sheets("Veri Giriş")
    Set S2 = Sheets("Data")
    
    Son = S2.Cells(S2.Rows.Count, 2).End(3).Row + 1
    
    For X = 1 To 24
        S2.Cells(Son, X + 1) = Me.Controls("TextBox" & X).Value
        Me.Controls("TextBox" & X).Value = ""
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub

 

[Lokmanx]

Teşekkür ederim Korhan Bey ,

Emeğinize sağlık elleriniz dert görmesin

 

[Lokmanx]

Korhan Bey Merhaba ,

Ekte bazı değişmler yapmam gerekti. Texbox'lar varken verdiğiniz kodlar ile istediğim olmuştu ancak combobox'lar eklemek zorunda kaldım.

Combobox'lardan sonra kayıt işlemi gerçekleşmiyor.

Hem Combobox hemde textboxları aynı anda kaydedebilmem için yardımcı olmanız mümkün mü acaba ?

İyi çalışmalar

 

[Korhan Ayhan]

Önerdiğim yapıyı kullanabilmeniz için nesnelerin isimlerini değiştirmemeniz gerekir.

Son paylaştığınız dosyada nesnelerin bazılarının isimlerini değiştirmişsiniz. Böyle bir yapıda ortak kodlama yazmanın pek bir esprisi kalmaz.

4 satır For-Next döngüsü ile halledilen kayıt işlemi nesne sayısı kadar uzamak zorunda kalacaktır.

Böyle kullanmak istiyorsanız satır satır kayıt işlemini yapmanız gerekir.

Aşağıdaki döngü satırlarını kaldırın;

    For X = 1 To 24
        S2.Cells(Son, X + 1) = Me.Controls("TextBox" & X).Value
        Me.Controls("TextBox" & X).Value = ""
    Next

Yerine aşağıdaki satırları nesnelere göre yazarak çoğaltın. İki satır için örnek veriyorum. Siz formunuzdaki nesne isimlerine göre gerisini kendiniz yazarsınız. Yani #7-8 nolu mesajımda ki gibi bir yapı kurmanız gerekiyor.

    S2.Cells(Son, 2) = Me.TextBox1.Value
    S2.Cells(Son, 3) = Me.ComboBox1.Value
    'Diğer nesneleri altına yazarak çoğaltınız...

 

[Lokmanx]

Teşekkür ederim Korhan Bey

İyi çalışmalar