Txt'e dönüştürürken boşlukları silmede sorun yaşıyorum

[winpeace]

Ekte verilen.xls dosyasını unicode txt'e çevirirken arada birçok boşluk bırakıyordu.Forumda bulduğum aşağıdaki kodu kullandım bütün boşlukları kapatırken g ile h sütunu arasındaki boşluğu kapatmıyor.
Şu şekilde çıkıyor;

Sorum şu: Bu aradaki boşluğu nasıl kapatırız ve dönüştürürken unicode txt olarak dönüştürmesini nasıl sağlarız?

Sub AKTAR()
    Open "C:\deneme.TXT" For Output As #1
    For i = 2 To [c65536].End(3).Row
        Print #1, Cells(i, "a") & Cells(i, "b") & Cells(i, "c") & Cells(i, "d") & Cells(i, "e") & Cells(i, "f") & Cells(i, "g") & Cells(i, "h") & Cells(i, "ı") & Cells(i, "j") & Cells(i, "k") & Cells(i, "l") & Cells(i, "m") & Cells(i, "n")
    Next i
    Close #1
End Sub

 

[janveljan]

Bu kodlar işinize yarayacaktır, dener misiniz?

Sub AKTAR()
    Open "C:\deneme.TXT" For Output As #1
    For i = 1 To [C65536].End(3).Row
        veri = ""
        For j = 1 To 14
            veri = veri & Trim(Cells(i, j))
        Next
        Print #1, veri
    Next i
    Close #1
End Sub

 

[winpeace]

Teşekkürler.
Peki verdiğiniz kodlarla dönüştürürken unicode metin olarak değiştirmesini nasıl sağlayacağız?

 

[janveljan]

Bu konuyla ilgili çok fazla bilgim yok ama aşağıdaki linki bir inceleyin.

http://www.excel.web.tr/f60/file-system-object-t4488.html

 

[winpeace]

dEdE kullanıcısı'nın verdiği bu kod

Sub Unicodex()
    For i = 1 To [A65536].End(3).Row
        For j = 1 To 14
            Cells(i, j) = Trim(Cells(i, j))
        Next
    Next i
ActiveWorkbook.SaveAs Filename:="C:\deneme.txt", _
FileFormat:=xlUnicodeText
ActiveWorkbook.SaveAs Filename:="C:\deneme.xls", _
        FileFormat:=xlNormal

End Sub

unicode sorununu bu çözüyor ama boşluk sorununu çözmüyor.Sizin verdiğiniz kodla bu kodu nasıl bütünleştirebiliriz?

 

[janveljan]

Bu şekilde dener misiniz?

Sub Text_Dosyası_Oluştur_Yaz()
Dim ds, a
Set ds = CreateObject("Scripting.FileSystemObject")
Set a = ds.CreateTextFile("C:\Deneme.txt", True, True) 'İlk true Overwrite,İkinci False ASCII true olursa Unicode
    For i = 1 To [C65536].End(3).Row
        veri = ""
        For j = 1 To 14
            veri = veri & Trim(Cells(i, j))
        Next
        a.writeline (veri)
    Next i
    a.Close
End Sub

 

[winpeace]

elinize sağlık oldu