Soru Toplu .txt Dosyası Düzenleme ve Taşıma

[knnklc]

İyi geceler. Elimde @Emir Hüseyin Çoban Beyin hazırlamış olduğu metin düzenleme makrosu mevcut. Ancak ben bir ekleme yapmak istiyorum. Oluşan metinler; mevcut klasörün içinde bir klasör daha oluştursun, onun içine kaydetsin...

Şuanki Hali:
Hedef Klasör'de ki 1.txt dosyası;
Hedef Klasör'e 1_demo.txt olarak kayıt oluyor...


Olmasını istediğim:
Hedef Klasör'de ki 1.txt dosyası;
Hedef Klasör'ün içinde bir demo klasörü oluşmasını ve içine 1.txt olarak kayıt olmasını istiyorum.

Bunu nasıl yapabilirim? Yardımlarınızı bekliyorum.

Mevcut kod:

Sub test()
    Dim kaynak As String, hedef As String, tum_metin, sat As Long
  
  
    Dim Y As Worksheet: Set Y = Sheets("YOL")
    Dim V As Worksheet: Set V = Sheets("VERİ")
  
    For i = 2 To Y.Cells(Rows.Count, "A").End(3).Row
      
        kaynak = Y.Cells(i, "A")
        uzunluk = Len(kaynak) - 4
        hedef = Left(kaynak, uzunluk) & "_demo.txt"
      
        tum_metin = CreateObject("scripting.filesystemobject").Opentextfile(kaynak).readall
      
        For sat = 1 To V.Cells(Rows.Count, "A").End(3).Row
            tum_metin = Replace(tum_metin, V.Cells(sat, "a"), _
            V.Cells(sat, "b")) 'BÜYÜK-küçük duyarlı ve hızlı.
        Next
      
        Open hedef For Output As #1
        Print #1, tum_metin
        Close #1

    Next i
  
End Sub

 

[knnklc]

Yardımcı olacak yok mu?