Çözüldü XML sayfasına aktarma

[sirkülasyon]

Ekli dosyamın Sayfa1 sekmesinde yer alan bilgileri ;
XML sayfasında yer alan Belge türü kısmına metin olarak 13
XML sayfasında yer alan Kanun No kısmına da metin olarak beş tane sıfır olacak şekilde
XML sayfalarına ekte örneklenmiş olduğu gibi aktarmak istiyorum.

Makro kodunu altın üyeliğim sona erdiğinden dolayı cevapta paylaşmanızı rica ediyorum.
Saygılarımla


DOSYA

 

[veyselemre]

Sub aktar()
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("XML")
    
    's2.Range("C14:J" & Rows.Count).ClearContents
    bas = Cells(Rows.Count, 3).End(3).Row - 6

    son = s1.Cells(Rows.Count, 1).End(3).Row
    For i = 7 To son
        s2.Cells(bas + i, "C").Value = 13
        s2.Cells(bas + i, "D").NumberFormat = "@"
        s2.Cells(bas + i, "D").Value = String(6, "0")
        s2.Cells(bas + i, "E").Resize(, 2).Value = s1.Cells(i, "A").Value
        s2.Cells(bas + i, "G").Resize(, 2).Value = Split(s1.Cells(i, "B").Value, ",")
        s2.Cells(bas + i, "J").Value = s1.Cells(i, "X").Value
    Next i
    Set s1 = Nothing
    Set s2 = Nothing

End Sub

 

[sirkülasyon]

Sayın veyselemre
Mükemmel aktarıyor. Ancak; 2. satırdan itibaren aktarıyor.
1 - 14. Satıdan itibaren aktarması için
2 - Rakamları aktarırken 4152,98 gibi değeri 4152.98 olarak aktarması için tekrar yardımcı olabilir misiniz?

 

[sirkülasyon]

Aktar Makrosunda
1 - 14. Satıdan itibaren aktarması ve rakamları aktarırken 4152,98 gibi değeri 4152.98 olarak aktarması için yardımcı olabilir misiniz?

 

[veyselemre]

Sayın veyselemre
Mükemmel aktarıyor. Ancak; 2. satırdan itibaren aktarıyor.
1 - 14. Satıdan itibaren aktarması için
2 - Rakamları aktarırken 4152,98 gibi değeri 4152.98 olarak aktarması için tekrar yardımcı olabilir misiniz?

1- C13 hücresi boş sa 2 satırdan itibaren atar, örnek dosyanızda herhangi bir sorun yoktu.
2-Ondalık simgesi olarak nokta kullanırsanız bu sorunları hiç yaşamazsınız.

Yine de aynen devam etmek istiyorsanız, aşağıdaki kodu bir deneyin.

Sub aktar()
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("XML")
    
    s2.Range("C14:J" & Rows.Count).ClearContents
    bas = 7 ' Cells(Rows.Count, 3).End(3).Row - 6

    son = s1.Cells(Rows.Count, 1).End(3).Row
    For i = 7 To son
        s2.Cells(bas + i, "C").Value = 13
        s2.Cells(bas + i, "D").NumberFormat = "@"
        s2.Cells(bas + i, "D").Value = String(6, "0")
        s2.Cells(bas + i, "E").Resize(, 2).Value = s1.Cells(i, "A").Value
        s2.Cells(bas + i, "G").Resize(, 2).Value = Split(s1.Cells(i, "B").Value, ",")
        s2.Cells(bas + i, "J").NumberFormat = "@"
        's2.Cells(bas + i, "J").Value = Replace(Format(s1.Cells(i, "X").Value, "0.00"), ",", ".")
        s2.Cells(bas + i, "J").Value = Format(s1.Cells(i, "X").Value, , "0.00")
    Next i
    Set s1 = Nothing
    Set s2 = Nothing

End Sub

 

[sirkülasyon]

Çok Teşekkür ederim. Sağ olasın