txt dosyası yaparken eksik tamamlama

[Tevfik_Kursun]

Merhaba Arkadaşlar,
I11 den itibaren I sütununda olan verileri J1 deki isimle txt dosyası olarak kayıt etmek istiyorum. Kırmızı ile belirttiğim bölümü başaramadım, yardımcı olursanız sevinirim.
Saygılarımla

Sub TxtBas()
    Dim DosyaAdi    As String
    Dim Veri        As String
    
    isim = Range("J1").Value
    DosyaAdi = "C:\Users\Administrator\Desktop\" & isim
    Open DosyaAdi For Output As #1
    
    Range("I11").Select
    Range(Selection, Selection.End(xlDown)).Select
        
'    Veri = [COLOR="Red"]Range(Selection, Selection.End(xlDown)).Select.Value[/COLOR]
    
    Print #1, Veri
    Close #1
    
End Sub

 

[Necdet]

Merhaba,

Tam olarak ne yapmak istediğinizi anlamadım.
Ama şunu belirtmek gerekir; text dosyasına range olarak yazdıramazsınız. Döngü ile yazdırmanız gerekir.

 

[Orion1]

Şöyle deneyin.

veri=activecell.value

 

[halit3]

Alternatif kod

Sub TxtBas()

Application.ScreenUpdating = False

Dim wbDest As Workbook
Dim fName As String

Set wsSource = ActiveSheet
Range("I11").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Set wbDest = Workbooks.Add

wbDest.Worksheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Application.DisplayAlerts = False

isim = Range("J1").Value
fName = "C:\Users\Administrator\Desktop\" & isim

wbDest.SaveAs fName, xlText
wbDest.Close SaveChanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[Tevfik_Kursun]

İlginize teşekkür ederim Sayın Evren Hocam,
Sadece I11 hücresini (ilk kaydı) yazdırıyor. For - Next döngüsü kurulduğunda da sürekli ilk kaydı tekrarlıyor.
Sizin de ilginize teşekkür ederim Sayın Necdet Hocam, bütün istediğim, var olan txt dosyasını I11 den itibaren I sütuna alıp, düzelttikten sonra yeni isimle aynı klasöre kayıt yapmayı istiyorum. Ben doğru For - Next döngüsünü kuramadım.
Galiba Halit3 Hocam da bir çalışma gönderdi. Onu da inceleyeyim. Hepinize tekrar teşekkür ediyorum.
Saygılarımla

 

[Orion1]

Siz dosya adındaki yolu istediğiniz yazabilirisiniz.
Buyurun.

Sub txtyaz59()
Dim sonsat As Long, hcr As Range
Dim DosyaAdi    As String
Dim Veri As String
sonsat = Cells(Rows.Count, "I").End(xlUp).Row
isim = Range("J1").Value
DosyaAdi = ThisWorkbook.Path & "\" & isim
Open DosyaAdi For Output As #1
For Each hcr In Range("I11:I" & sonsat)
    Print #1, hcr.Value
Next
Close #1
MsgBox "Veriler yazıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[Tevfik_Kursun]

Sayın Halit3 Hocam,
Sondan 5. satırda "wbDest.SaveAs fName, xlText" hata veriyor. Debug dediğinizde de verileri toplu halde excel dosyada A sütununa atıyor.
Nedenini anlamadım.
İlginize teşekkür ederim.
Saygılarımla

 

[Orion1]

6 nolu mesajda yanıt verdim.

 

[Tevfik_Kursun]

Çok teşekkür ederim Evren Hocam,
Elinize sağlık istediğim gibi çalıştı.
Saygılarımla

 

[halit3]

Sayın Halit3 Hocam,
Sondan 5. satırda "wbDest.SaveAs fName, xlText" hata veriyor. Debug dediğinizde de verileri toplu halde excel dosyada A sütununa atıyor.
Nedenini anlamadım.
İlginize teşekkür ederim.
Saygılarımla

Klasör yolu veya dosya adı aksanlı herfler kullanmayınız.
Yani kayıt yaparken dosaya ismini resimde görünen karekterleri kullanmayınız.

Ben ofis 2003 kullanıyorum aşağıdaki kod dosyanın hemen yanına deneme.txt dosyası olarak kayıt yapıyor.

Sub Foo_Tab()

Application.ScreenUpdating = False

Dim wbDest As Workbook
Dim fName As String

Set wsSource = ActiveSheet
Range("I11").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Set wbDest = Workbooks.Add

wbDest.Worksheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Application.DisplayAlerts = False

fName = ThisWorkbook.path & "\deneme.txt"
'isim = Range("J1").Value
'fName = "C:\Users\Administrator\Desktop\" & isim
wbDest.SaveAs fName, xlText
wbDest.Close SaveChanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[Tevfik_Kursun]

Evet, Halit3 Hocam,
Bu kod bende de çalıştı. İlginize çok teşekkür ederim.
Saygılarımla