Soru Dolu hücreleri arşive aktar

[theabir]

Merhaba

Ekteki dosyada sipariş detaylarında ki detayları arşive aktar dediğimde sadece ilk satırı almaktadır. Tüm satırları aktarılmasını istiyorum.
Ayrıca yeni numara ver dediğimde satış sözleme numarasına da +1 ekleyerek yenilenmesini istiyorum.
Yardımlarınızı rica ederim.

 

[AdemCan]

Merhaba, module1 de bulunan kodları değiştiriniz.

Public sonno As Integer
Sub numarala()
    Set s1 = Sheets("Form")
    Set s2 = Sheets("Arşiv")
    
    yil = Year(Date)
    son = s2.Cells(Rows.Count, "A").End(3).Row
'    sonno = WorksheetFunction.CountIf(s2.Range("B1:B" & son), yil)
    sonno = Right(s1.[D3], 2)
    
    s1.[D3] = "EK" & yil & Format(sonno + 1, "00")
    s1.[F10] = son
    s1.[K10] = s1.[D3]
End Sub
Sub aktar()
    Set s1 = Sheets("Form")
    Set s2 = Sheets("Arşiv")
    s1son = s1.Cells(Rows.Count, "M").End(3).Row
    

For i = 16 To s1son - 1
son = s2.Cells(Rows.Count, "A").End(3).Row + 1

    s2.Cells(son, "A") = son - 1
    s2.Cells(son, "B") = Mid([D3], 4, 4) * 1
    s2.Cells(son, "C") = Right([D3], 4) * 1
    s2.Cells(son, "D") = s1.[D3]
    s2.Cells(son, "E") = s1.[C8]
    s2.Cells(son, "F") = s1.[C9]
    s2.Cells(son, "G") = s1.[C10]
    s2.Cells(son, "H") = s1.[C11]
    s2.Cells(son, "I") = s1.[C12]
    s2.Cells(son, "J") = s1.[F9]
    s2.Cells(son, "K") = s1.[F10]
    s2.Cells(son, "L") = s1.[F12]
    s2.Cells(son, "M") = s1.[K9]
    s2.Cells(son, "N") = s1.[K10]
    s2.Cells(son, "O") = s1.[K11]
    s2.Cells(son, "P") = s1.[K12]
    

    s2.Cells(son, "Q") = s1.Cells(i, "A")
    s2.Cells(son, "R") = s1.Cells(i, "B")
    s2.Cells(son, "S") = s1.Cells(i, "C")
    s2.Cells(son, "T") = s1.Cells(i, "D")
    s2.Cells(son, "U") = s1.Cells(i, "E")
    s2.Cells(son, "V") = s1.Cells(i, "F")
    s2.Cells(son, "W") = s1.Cells(i, "G")
    s2.Cells(son, "X") = s1.Cells(i, "H")
    s2.Cells(son, "Y") = s1.Cells(i, "I")
    s2.Cells(son, "Z") = s1.Cells(i, "J")
    s2.Cells(son, "AA") = s1.Cells(i, "L")
    s2.Cells(son, "AB") = s1.Cells(i, "M")
'    s2.Cells(son, "AC") = s1.[A19]
'    s2.Cells(son, "AD") = s1.[A20]

Next i
    MsgBox "Mevcut bilgiler Arşiv sayfasına aktarıldı.", vbInformation
End Sub

Arşiv sayfasında Açıklama1 ve Açıklama2 nin karşılığını Form sayfasında nereden alıyorsunuz?

 

[theabir]

Çok teşekkür ederim.

 

[AdemCan]

Rica ederim.