[ÇÖZÜLDÜ] metni sütunlara dönüştür kodunda düzenleme

[zulfuernek]

Range("A20").Select
Selection.TextToColumns Destination:=Range("A20"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(6, 9), Array(8, 1), Array(23, 1), Array(31, 9), _
Array(38, 1), Array(41, 9), Array(86, 1), Array(101, 1), Array(121, 9)), _
TrailingMinusNumbers:=True


yukarıdak kodda sadece ("A20") hücresinde metmn, sütunlara dönüştürüyor. kodda nasıl bir değişiklik yaparsak A1:N5000 hücre aralığında sütunlara böler

saygılrımı sunarım

 

[askm]

A1 hücresini sütunlara bölünce yan sütunlara yazıyor. B1:C1 şeklinde gidiyor.
B1 den sonraki veri silinmiş olmayacak mı? Aynı şekilde alttaki satırlarda aynı şekilde olacak.
Örnek dosya ekler ve olması gerekeni de yazarsanız yardımcı olmaya çalışalım.

 

[zulfuernek]

aynen hocam b1 c1 d1 ..... n1 diye bölecek.

işyerinde olduğum için örnek dosya ve dosya paylaşım ekleyemiyorum

 

[askm]

A1:A5000 arası için kod;

for i=1 to 5000
Range("A"& i).Select
Selection.TextToColumns Destination:=Range("A" & i ), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(6, 9), Array(8, 1), Array(23, 1), Array(31, 9), _
Array(38, 1), Array(41, 9), Array(86, 1), Array(101, 1), Array(121, 9)), _
TrailingMinusNumbers:=True
next i

 

[zulfuernek]

askm hocam aşağıdaki şekilde uyguladım ancak verdiğiniz bölümdeki renkli satırlar alanlar sarı zemin ile bpyanıyor. bir eksiklik var sanırım.

'MASAÜSTÜNDEN DOSYA SEÇİP AÇIYOR:
Dim i As Long, deg As String, sat As Long, deg2, k As Byte, dosya
Range("A1:N65536").Clear
ChDir (ThisWorkbook.Path)
dosya = Application.GetOpenFilename(filefilter:="Metin dosyaları(*.txt),(*.txt)", Title:="Bir metin dosyası seçiniz.")
If dosya = False Then Exit Sub
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Open (dosya) For Input As #1
Do While Not EOF(1)
Line Input #1, deg
sat = sat + 1
deg2 = Split(deg, vbTab)
k = 0
For i = 0 To UBound(deg2)
k = k + 1
Cells(sat, k).Value = deg2(i)
Next i
Loop
Close #1
Application.ScreenUpdating = True
MsgBox "veri.txt dosyasından veriler alınmıştır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"


' AÇILAN DOSYAYI HÜCRELERE BÖLÜÜYOR
For i = 1 To 5000
Range("A" & i).Select
Selection.TextToColumns Destination:=Range("A" & i), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(6, 9), Array(8, 1), Array(23, 1), Array(31, 9), _
Array(38, 1), Array(41, 9), Array(86, 1), Array(101, 1), Array(121, 9)), _
TrailingMinusNumbers:=True
Next i

 

[zulfuernek]

askm hocam çözüldü. emeğine sağlık. çok teşekkür ederim.

döngünün en başına

On Error Resume Next

ekleyince döngü tam istediğim gibi çalıştı.

teşekkür ederim