excelden txt aktarırken dosya adı verme

[qwerty1478]

merhaba arkadaslar asagıdakı kod ile sayfa2 deki verileri txt dosyasına test.txt olarak kayıt ediyor ben bu txt dosyasına sayfa1 deki p1 hucresindeki degeri vermesini ve sonunda test.txt degilde yenı olusturdugu txt dosyasını actırmak istiyorum ne gibi bir degisiklik yapmam gerek kodlar da

Sub Makro4()
Dim deg As String, i As Long, st As Long, j As Byte
st = Cells(Rows.Count, "A").End(xlUp).Row
Open (ThisWorkbook.Path & "\test.txt") For Output As #1
For i = 1 To st
    For j = 1 To 5
        deg = deg & " " & Cells(i, j)
    Next j
    deg = Right(deg, Len(deg) - 1)
    Print #1, deg
    deg = ""
Next i
Close #1
MsgBox "Not olusturuldu." & vbLf & ""
Shell "notepad.exe " & ActiveWorkbook.Path & "/test.txt"
End Sub

 

[halit3]

KOD

Sub Makro4()
Dim deg As String, i As Long, st As Long, j As Byte


st = Cells(Rows.Count, "A").End(xlUp).Row

dosya = Worksheets("Sayfa1").Range("P1").Value
Open (ThisWorkbook.Path & "\" & dosya) For Output As #1
For i = 1 To st
    For j = 1 To 5
        deg = deg & " " & Cells(i, j)
    Next j
    deg = Right(deg, Len(deg) - 1)
    Print #1, deg
    deg = ""
Next i
Close #1
MsgBox "Not olusturuldu." & vbLf & ""
Shell "notepad.exe " & ActiveWorkbook.Path & "/" & dosya
End Sub

 

[qwerty1478]

hocam run time error verdi.

resimag.com/p1/e569d803a46.png

 

[halit3]

kodun uzantısını yazmayı unutmuşum

Sub Makro4()
Dim deg As String, i As Long, st As Long, j As Byte


st = Cells(Rows.Count, "A").End(xlUp).Row

dosya = Worksheets("Sayfa1").Range("P1").Value & ".txt"
Open (ThisWorkbook.Path & "\" & dosya) For Output As #1
For i = 1 To st
    For j = 1 To 5
        deg = deg & " " & Cells(i, j)
    Next j
    deg = Right(deg, Len(deg) - 1)
    Print #1, deg
    deg = ""
Next i
Close #1
MsgBox "Not olusturuldu." & vbLf & ""
Shell "notepad.exe " & ActiveWorkbook.Path & "/" & dosya
End Sub

 

[qwerty1478]

Çok tesekurler hocam işlem tamam.

 

[halit3]

Teşekkürler iyi çalışmalar