Aktar Kaydet (Birleştirilmiş Hücreler)

[sirkülasyon]

Aktarılacak sayfa = Sheets("Deneme")
C sütununda 4'üncü, 5'inci ve 6' ncı Satırlar birleştirilmiş Bu sütuna TextBox1
D sütununda 4'üncü, 5'inci ve 6' ncı Satırlar birleştirilmiş Bu sütuna TextBox2
E sütununda 4'üncü, 5'inci ve 6' ncı Satırlar birleştirilmiş Bu sütuna TextBox14
F sütununda 4'üncü, 5'inci ve 6' ncı Satırlar birleştirilmiş Bu sütuna TextBox12
G sütununda 4'üncü, 5'inci ve 6' ncı Satırlar birleştirilmiş Bu sütuna TextBox13
I sütunu birleştirilmemiş
4. satıra Combobox1
5. satıra Combobox2
6. satıra Combobox3
J sütunu birleştirilmemiş
4. satıra TextBox3
5. satıra TextBox4
6. satıra TextBox5
K sütunu birleştirilmemiş
4. satıra TextBox6
5. satıra TextBox7
6. satıra TextBox8
L sütunu birleştirilmemiş
4. satıra TextBox9
5. satıra TextBox10
6. satıra TextBox11

M sütununda 4'üncü, 5'inci ve 6' ncı Satırlar birleştirilmiş Bu sütuna TextBox15
N sütununda 4'üncü, 5'inci ve 6' ncı Satırlar birleştirilmiş Bu sütuna TextBox16
O sütununda 4'üncü, 5'inci ve 6' ncı Satırlar birleştirilmiş Bu sütuna TextBox17
P sütununda 4'üncü, 5'inci ve 6' ncı Satırlar birleştirilmiş Bu sütuna TextBox18
Q sütununda 4'üncü, 5'inci ve 6' ncı Satırlar birleştirilmiş Bu sütuna TextBox19
R sütununda 4'üncü, 5'inci ve 6' ncı Satırlar birleştirilmiş Bu sütuna TextBox20
verilerini kayıt edecek.
Bir sonraki kayıt işlemini 3 satır atlayarak yapacak bir kod örneğine ihtiyacım var. Yardımcı olabilir misiniz?

 

[cems]

Sub VeriKaydetVeAtla()
    Dim ws As Worksheet
    Dim i As Integer
    
    ' Çalışma sayfasını belirle
    Set ws = Sheets("Deneme")
    
    ' Aktarılacak sütunları ve nesneleri belirle
    Dim sütunlar As Variant
    Dim nesneler As Variant
    sütunlar = Array("C", "D", "E", "F", "G", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R")
    nesneler = Array("TextBox1", "TextBox2", "TextBox14", "TextBox12", "TextBox13", "ComboBox1", "ComboBox2", _
                     "ComboBox3", "TextBox3", "TextBox4", "TextBox5", "TextBox6", "TextBox7", "TextBox8", _
                     "TextBox9", "TextBox10", "TextBox11", "TextBox15", "TextBox16", "TextBox17", "TextBox18", "TextBox19", "TextBox20")
    
    ' Her 3 satırda bir kayıt işlemini tekrarla
    For i = 4 To ws.Cells(Rows.Count, "C").End(xlUp).Row Step 3
        ' Sütunlardan verileri al ve nesnelere yerleştir
        For j = 0 To UBound(sütunlar)
            If sütunlar(j) <> "I" And sütunlar(j) <> "J" And sütunlar(j) <> "K" And sütunlar(j) <> "L" Then
                ' Birleştirilmiş sütunlardaki verileri al
                Dim birleştirilmişVeri As String
                birleştirilmişVeri = ws.Range(sütunlar(j) & i & ":" & sütunlar(j) & i + 2).Value
                
                ' Nesnelere veriyi yerleştir
                If sütunlar(j) = "C" Or sütunlar(j) = "D" Or sütunlar(j) = "E" Or sütunlar(j) = "F" Or sütunlar(j) = "G" Then
                    Controls(nesneler(j)).Text = birleştirilmişVeri
                Else
                    Controls(nesneler(j)).Value = birleştirilmişVeri
                End If
            End If
        Next j
        
        ' Verileri kaydet
        ' Burada kayıt işlemini gerçekleştirecek kodunuzu ekleyin.
        
        ' 3 satır atla
        i = i + 2
    Next i
End Sub

Deneyiniz, dosya olmadığından kod onerisi gonderiyorum .Kayıt işlemi kısmına gerçek kaydetme işlemlerini eklemeniz gerekiyor.

 

[sirkülasyon]

Ömrün uzun olsun. Ellerine sağlık

 

[cems]

İnşallah cümlemizin ; kolay gelsin