Metni sütünlara bölme

[Rdlkknr]

merhaba,
A1 satırındaki 1800 karekterden oluşan metini 18'erli olarak ayırmak istiyorum.mevcut yapılmış örnek olan varsa paylaşabilir mi ?

yardımlarınız için şimdiden teşekkür ederim

 

[çıtır]

Deneyiniz.

Sub parcala()
Dim s1 As Worksheet: Dim i As Long
Set s1 = Sheets("Sayfa1")
son = WorksheetFunction.RoundUp(1800 / 18, 0)
For i = 1 To son
s1.Cells(1, i + 1) = Mid(s1.Range("A1"), (i) * 18 - 17, 18)
Next i
End Sub

 

[Rdlkknr]

Yardımınız için çok teşekkür ederim yazdığınız kod çalışıyor . ben bu metni alt alta yazdırmak istersem ve 18 değilde 20 olmasını istediğimde kodun hangi bölümlerine müdahale etmeliyim.

 

[Rdlkknr]

Deneyiniz.

Sub parcala()
Dim s1 As Worksheet: Dim i As Long
Set s1 = Sheets("Sayfa1")
son = WorksheetFunction.RoundUp(1800 / 18, 0)
For i = 1 To son
s1.Cells(1, i + 1) = Mid(s1.Range("A1"), (i) * 18 - 17, 18)
Next i
End Sub

Yardımınız için çok teşekkür ederim yazdığınız kod çalışıyor . ben bu metni alt alta yazdırmak istersem ve 18 değilde 20 olmasını istediğimde kodun hangi bölümlerine müdahale etmeliyim.

 

[çıtır]

Aşağıdaki şekilde

Sub parcala()
Dim s1 As Worksheet: Dim i As Long
Set s1 = Sheets("Sayfa1")
son = WorksheetFunction.RoundUp(1800 / 20, 0)
For i = 1 To son
s1.Cells(i + 1,1) = Mid(s1.Range("A1"), (i) * 20 - 19, 20)
Next i

 

[steppe]

Yukarıdaki kodun üzerinde epey çalıştım fakat bir türlü beceremedim.
A1 hücresinde verinin ilk 10 karekteri A1 hücresinde kalsa ondan sonra kaç karakter kalırsa kalsın B1 hücresine aktarsa, kodda nasıl bir düzenleme yapabiliriz.

 

[çıtır]

Deneyiniz.

Sub parcala()
Dim s1 As Worksheet: Dim i As Long
Set s1 = Sheets("Sayfa1")
son = s1.Cells(65336, "A").End(3).Row
For i = 1 To son
al = s1.Range("A" & i)
s1.Cells(i, 2) = Mid(al, 11, Len(al))
d = Left(al, 10)
s1.Range("A" & i) = d
Next i
End Sub

 

[steppe]

Çıtır Kardeş,
Yardımlarınız için çok teşekkür ederim.

 

[çıtır]

Çıtır Kardeş,
Yardımlarınız için çok teşekkür ederim.

Rica ederim.Dönüş yaptığınız için teşekkür ederim.