Çalışma sayfası x aktar sekme şablonları farklı

[netvolxxx]

merhaba çalışma sayfamda taslak sekmesinde olan a17 den başlayan hücreye x yazıp x aktar buton ile form sayfasına aktarma yapmak istiyorum

bu işlemi sayfa şablonu form kısmı aynı iken yapabiliyordum şablonun dışına çıktım ve işin içinden çıkamadım bi türlü yardımlarınızı bekliyorum üstadların.

taslak sayfasında aktarılması istediğim hücrelere numara verdim bu numaralar karşılığı form sayfasında ilgili hücrelerde de yazıyor.

örnek çalışma excel dosyanı ekledim.

 

[AdemCan]

Merhaba örnek kod.

Private Sub CommandButton1_Click()
Dim s1 As Worksheet, s2 As Worksheet
Dim son1 As Long, son2 As Long, i As Long, x As Long, y As Byte

Set s1 = Sheets("taslak"): son1 = s1.Cells(Rows.Count, "B").End(3).Row
Set s2 = Sheets("Form")
Temizle

    For i = 17 To son1
        With s1
            If .Cells(i, 1) = "x" Or .Cells(i, 1) = "X" Then
            son2 = s2.Cells(Rows.Count, "C").End(3).Row + 1
            For y = 3 To 7 Step 2
                s2.Cells(son2, "C") = .Cells(i, y)
                son2 = son2 + 1
            Next y

                s2.Cells(son2, "C") = .Cells(i, 8)
                son2 = son2 + 1
                s2.Cells(son2, "C") = .Cells(i, 9)
                s2.Cells(son2 - 4, "D") = .Cells(i, 10)
                s2.Cells(son2 - 4, "E") = .Cells(i, 11)
                .Cells(i, 1) = "Aktarıldı"
            End If
        End With
    Next i
    
End Sub

 

[netvolxxx]

Merhaba örnek kod.

Private Sub CommandButton1_Click()
Dim s1 As Worksheet, s2 As Worksheet
Dim son1 As Long, son2 As Long, i As Long, x As Long, y As Byte

Set s1 = Sheets("taslak"): son1 = s1.Cells(Rows.Count, "B").End(3).Row
Set s2 = Sheets("Form")
Temizle

    For i = 17 To son1
        With s1
            If .Cells(i, 1) = "x" Or .Cells(i, 1) = "X" Then
            son2 = s2.Cells(Rows.Count, "C").End(3).Row + 1
            For y = 3 To 7 Step 2
                s2.Cells(son2, "C") = .Cells(i, y)
                son2 = son2 + 1
            Next y

                s2.Cells(son2, "C") = .Cells(i, 8)
                son2 = son2 + 1
                s2.Cells(son2, "C") = .Cells(i, 9)
                s2.Cells(son2 - 4, "D") = .Cells(i, 10)
                s2.Cells(son2 - 4, "E") = .Cells(i, 11)
                .Cells(i, 1) = "Aktarıldı"
            End If
        End With
    Next i
   
End Sub

üstad süpersin ya sağol tam istediğim buydu teşeküüür ederim....

 

[AdemCan]

Rica ederim.