verileri not defterine aktarma

[farukuz]

kitap1 den süzülen, kitap 2 de yer alan verileri, belirlenen satır-sütun adetlerini kapsayacak şekilde birden fazla not defterine aktarma imkanı var mıdır?

http://www.excel.web.tr/f48/not-defterine-aktarma-t36297.html adresindeki durum sorunumu çözmedi.

örnek ekteki gibidir.

 

[farukuz]

soru geride kaldı.. istediğim şeyin çözümü yok mudur acaba?

 

[Zeki Gürsoy]

Merhaba,

Dosyanızı 2003 formatında ekleyebilir misiniz?

 

[farukuz]

..

2003 versiyonu ekteki gibidir.

 

[Zeki Gürsoy]

Dosyaları masaüstüne kaydedecek; deneyin...

Sub test()

    Open Environ("userprofile") & "\Desktop\A_sütun.txt" For Output As #1
        For z = 1 To Sheets("sayfa2").[a65536].End(3).Row
            Print #1, Sheets("sayfa2").Cells(z, "a")
        Next
    Close #1
    
    Open Environ("userprofile") & "\Desktop\C_sütun.txt" For Output As #1
        For z = 1 To Sheets("sayfa2").[a65536].End(3).Row
            Print #1, Sheets("sayfa2").Cells(z, "c")
        Next
    Close #1

End Sub

 

[farukuz]

çok teşekkür ederim.. büyük bir iyilik yaptınız bana..
şu mümkün müdür? a sütununda ya da c sütununda yüzlerce veri olacak ama bu sütunlardaki verileri 20 şerli gruplar halinde metin belgesine aktarmak mümkün mü? (a1 ile a20, a21 ile a40, a41 ile a60.... c1ile c20..vb..)

 

[Zeki Gürsoy]

Elbette mümküm. Dosyalar nereye kaydedilecek? Çünkü kalabalık text dosyası olacak.

 

[farukuz]

aslında şu iyi olacak.. masaüstüne ilgili excelin de olduğu bir klasör (örn., xxxx isimli klasör), bu klasörün içine oluşan txt ler şeklinde??

 

[farukuz]

bi de çok oldu ama.. birer boşluklu olarak atıyor metin belgesine sayıları? normal mi?

 

[Zeki Gürsoy]

Deneyin...

*** Boşluk çıkarıldı ***

Sub test()
f = Environ("userprofile") & "\Desktop\" & _
    Replace(ThisWorkbook.Name, ".xls", "_text")

If Dir(f, vbDirectory) = "" Then MkDir f
    
    s = 1
    
    For z = 1 To Sheets("sayfa2").[a65536].End(3).Row
    
        Open f & "\A_" & s & ".txt" For Append As #1
            Print #1, Trim(Sheets("sayfa2").Cells(z, "a"))
        Close #1
        
        If (z Mod 20) = 0 Then s = s + 1
    Next
        
    s = 1
    
    For z = 1 To Sheets("sayfa2").[c65536].End(3).Row
    
        Open f & "\C_" & s & ".txt" For Append As #1
            Print #1, Trim(Sheets("sayfa2").Cells(z, "c"))
        Close #1
        
        If (z Mod 20) = 0 Then s = s + 1
    Next

End Sub

 

[farukuz]

tek kelimeyle mükemmel. çok teşekkür ederim.. bu daha da büyük bir iyilik oldu.

 

[farukuz]

şöyle bir sıkıntı oluştu... sayfa2 ye verileri sayfa birden süzerek alıyor.. ve 500. satıra kadar formul var..( aslında formülde eğer boşsa boş bırak seçeneği var ama) bu yüzden de satılarda veri olmasa bile txt belgesi oluşturuyor. çözümü var mıdır?

 

[Zeki Gürsoy]

Sub test_son()
f = Environ("userprofile") & "\Desktop\" & _
    Replace(ThisWorkbook.Name, ".xls", "_text")

If Dir(f, vbDirectory) = "" Then MkDir f
    
    s = 1
    
    For z = 1 To Sheets("sayfa2").[a65536].End(3).Row
        
        If Trim(Sheets("sayfa2").Cells(z, "a")).Value <> "" Then
        
            Open f & "\A_" & s & ".txt" For Append As #1
                Print #1, Trim(Sheets("sayfa2").Cells(z, "a"))
            Close #1
            
        End If
        
        If (z Mod 20) = 0 Then s = s + 1
    Next
        
    s = 1
    
    For z = 1 To Sheets("sayfa2").[c65536].End(3).Row
        
        If Trim(Sheets("sayfa2").Cells(z, "c")).Value <> "" Then
        
            Open f & "\C_" & s & ".txt" For Append As #1
                Print #1, Trim(Sheets("sayfa2").Cells(z, "c"))
            Close #1
            
        End If
        
        If (z Mod 20) = 0 Then s = s + 1
    Next

End Sub

 

[farukuz]

tekrar çok teşekkür ederim.emeğiniz için. deneme şansım olmadı ama eminim ihtiyacımı karşılayacaktır.



Edit : hata verdi! Çalıştıramadım " If Trim(Sheets("sayfa2").Cells(Z, "a")).Value <> "" Then " kodu

 

[farukuz]

bir de bundan bağımsız şöyle bir şey mümkün mü? a ve b sütunundaki veriyi birlikte tek bir not defterine aktarma.?