Soru Çoklu Txt Yapma (Filtreli)

[leonadies]

Değerli Üstadlar;

Ekteki excelde yer alan bilgilerde;

C sütunundaki Kelimelere göre ayırarak o kelime adında excelin o an bulunduğu yere ayrı ayrı TXT dosya yapmak istiyorum. Aralarıda ; işareti ile bağlamak istiyorum. Mümkün mü?

Not: C sütunundaki bilgiler karışık olabiliyor.
Dosyalarımı ekledim.

VAROLAN DURUM;


----------------------------------------------------------------------------------------------------------------------------------------
İSTEDİĞİM SONUÇ

 

[Haluk]

Deneyiniz...

Sub Test()
'   Haluk - 28/04/2021
'   sa4truss@gmail.com
'   https://excelhaluk.blogspot.com/

    Dim NoA As Long, FSO As Object, objTxtFile As Object
    Const ForAppending = 8
    
    NoA = Range("A" & Rows.Count).End(xlUp).Row
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    For i = 1 To NoA
        Set objTxtFile = FSO.OpenTextFile(ThisWorkbook.Path & "\" & Range("C" & i) & ".txt", ForAppending, True)
        objTxtFile.Writeline (Range("A" & i) & ";" & Range("B" & i) & ";" & Range("D" & i))
        objTxtFile.Close
    Next
    
    Set objTxtFile = Nothing
    Set FSO = Nothing
End Sub

.

 

[leonadies]

Ellerine Sağlık @Haluk üstadım. Yine çok net kodlar kısa anlaşılır.
Çok teşekkür ederim

 

[leonadies]

Merhaba bu işlemde uzantının .TXT değilde .XLS olarak (excel dosyası) çıkarmak istiyorum. Noktalı virgüllerin her biri bir sütuna gelecek şekilde. Nasıl yapabilirim?

 

[pitchoute]

Merhabalar, şu şekilde deneyip sonucu paylaşabilir misiniz;

Sub Test()
    ' Haluk - 28/04/2021
    ' sa4truss@gmail.com
    ' https://excelhaluk.blogspot.com/
    
    Dim NoA As Long
    Dim wbNew As Workbook
    Dim wsNew As Worksheet
    Dim i As Long
    Dim FilePath As String
    Dim FileName As String
    Dim ValueA As Variant
    Dim ValueB As Variant
    Dim ValueD As Variant

    NoA = Range("A" & Rows.Count).End(xlUp).Row

    For i = 1 To NoA
        ValueA = Range("A" & i).Value
        ValueB = Range("B" & i).Value
        ValueD = Range("D" & i).Value
        FileName = Range("C" & i).Value & ".xls"
        FilePath = ThisWorkbook.Path & "\" & FileName

        Set wbNew = Workbooks.Add(xlWBATWorksheet) 

        Set wsNew = wbNew.Sheets(1)

        wsNew.Range("A1").Value = ValueA
        wsNew.Range("B1").Value = ValueB
        wsNew.Range("C1").Value = ValueD

        Application.DisplayAlerts = False 
        wbNew.SaveAs Filename:=FilePath, FileFormat:=xlExcel8 ' xlExcel8 = Excel 97-2003 Workbook (.xls)
        Application.DisplayAlerts = True 

        wbNew.Close SaveChanges:=False

        Set wbNew = Nothing
        Set wsNew = Nothing
    Next i

End Sub

 

[NBATMAN]

Merhaba,

konu ile ilgili hem sizin sorunuza hem de genel maksatlı tüm benzer sorunlara çözüm üretecek şekilde bir program yaptım.
İlgili Excel (kaynak) dosyanızı ilk buton ile açıyorsunuz. Sonra birinci açılır kutudan hangi sayfa ile işlem yapacaksanız onu seçiyorsunuz. İkinci açılır kutuda o sayfaya ait sütün başlıkları listeleniyor. Buradan seçtiğiniz sütuna göre XLS kaydet yada TXT kaydet butonlarına basarak seçmiş olduğunuz sütundaki verilere göre Excel yada text formatında kaydediyor. Dikkat edilecek husus şudur ki kaynak dosyadaki tablolarda mutlaka 1. satır sütun başlıklarını adı içermeli örneğin ekteki Excel dosyası gibi.