Birleştirilmiş hücre şartlı diğer sayfaya aktarma

[netvolxxx]

merhaba çok uğraşmama rağmen bi türlü yapamadım şu olayı istediğimi
sorunum şu

çalışma sayfamda taslak sayfasında x aktar butonu var a alanı x yazdığım bilgi sayfasına aktarma yapıyor fakat bazı alanlar birleştirilmiş hücre olduğu için taslak sayfası c alanındaki verileri bir türlü aktarma yapamadım.

kullandığım kod şu şekilde.

çalışma dosyasına ekledim.
bu işlem sayfa şablonu taslakta 473 satıra kadar devam ediyor..
hazır makro ile yapayım dedim oda işlem çok uzun sürüyor 473 satıra kadar inip sonra işlemi bitiriyor çıkamadım işin işinden...
yardımlarınızı bekliyorum....


Private Sub CommandButton1_Click()
Set s1 = Sheets("Bilgi")
Set s2 = Sheets("TASLAK")
ss2 = s2.Cells(Rows.Count, "B").End(3).Row
ss1 = 28
For i = 7 To ss2
If s2.Cells(i, 1).Value = "X" Or s2.Cells(i, 1).Value = "x" Then
s1.Cells(ss1, 2) = s2.Cells(i, 3)
s1.Cells(ss1, 3) = s2.Cells(i, 4)
s1.Cells(ss1, 4) = s2.Cells(i, 5)
s1.Cells(ss1, 5) = s2.Cells(i, 6)
s1.Cells(ss1, 6) = s2.Cells(i, 7)
s2.Cells(i, 1) = "AKTARILDI"
ss1 = ss1 + 5
End If
Next i
End Sub

 

[Korhan Ayhan]

Merhaba,

Kodu aşağıdaki gibi deneyiniz. Kod bu haliyle X yazdıklarınızı BİLGİ sayfasına alt alta biriktirerek aktaracaktır.

Private Sub CommandButton1_Click()
    Set s1 = Sheets("Bilgi")
    Set s2 = Sheets("TASLAK")
    ss2 = s2.Cells(s2.Rows.Count, "B").End(3).Row
    ss1 = s1.Cells(s1.Rows.Count, "B").End(3).Row
    If ss1 < 28 Then ss1 = 28 Else ss1 = ss1 + 5
    
    For i = 18 To ss2
        If s2.Cells(i, 1).Value = "X" Or s2.Cells(i, 1).Value = "x" Then
            s1.Cells(ss1, 2) = s2.Cells(i, 3)
            s1.Range("C" & ss1).Resize(5).Value = s2.Cells(i, 4).Resize(5).Value
            s1.Cells(ss1, 4) = s2.Cells(i, 5)
            s2.Cells(i, 1) = "AKTARILDI"
            ss1 = ss1 + 5
        End If
    Next i
End Sub

 

[netvolxxx]

Merhaba,

Kodu aşağıdaki gibi deneyiniz. Kod bu haliyle X yazdıklarınızı BİLGİ sayfasına alt alta biriktirerek aktaracaktır.

Private Sub CommandButton1_Click()
    Set s1 = Sheets("Bilgi")
    Set s2 = Sheets("TASLAK")
    ss2 = s2.Cells(s2.Rows.Count, "B").End(3).Row
    ss1 = s1.Cells(s1.Rows.Count, "B").End(3).Row + 5
   
    For i = 18 To ss2
        If s2.Cells(i, 1).Value = "X" Or s2.Cells(i, 1).Value = "x" Then
            s1.Cells(ss1, 2) = s2.Cells(i, 3)
            s1.Range("C" & ss1).Resize(5).Value = s2.Cells(i, 4).Resize(5).Value
            s1.Cells(ss1, 4) = s2.Cells(i, 5)
            s2.Cells(i, 1) = "AKTARILDI"
            ss1 = ss1 + 5
        End If
    Next i
End Sub

korhan hocam denedim fakat sadece taslak sayfasında ki sadece d alanını aktarıyor diğer lerini aktarma yapmıyor taslak sayfasında c-d-e hücerlerinde verileri bilgi sayfasına aktarma işlemi
kodda ayrıca hocam taslak sayfası d alanı aktarırken bilgi sayfasına 32 satırdan başlıyor. 28 satırdan başlaması...

 

[Korhan Ayhan]

Koda küçük bir ekleme yaptım. Tekrar deneyiniz..

 

[netvolxxx]

Koda küçük bir ekleme yaptım. Tekrar deneyiniz..

korhan hocam süper teşeküürr ederim sağolun allah razı olsun...