filtrelenen satırları txt dosyasına aktarım

[frtnamu]

filtrelenmiş satırları txt dosyasına aktarmak istiyorum
a.writeline ile yazılan metin aktarılıyor.
yardımlarınızı bekliyorum teşekkürler.


Sub aktar()

Selection.AutoFilter
ActiveSheet.Range("$A$1:$G$1047").AutoFilter Field:=7, Criteria1:="1"

son = Workbooks("kitap1.xls").Worksheets("sayfa1").[A65536].End(3).Row
aktarılacak = Workbooks("kitap1.xls").Worksheets("sayfa1").["F2:F & SON]
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("C:\Auto.txt", True)

a.WriteLine ("aktarılacak")

a.Close
End Sub

 

[Orion1]

Sub aktar()
ActiveSheet.Range("$A$1:$G$1047").AutoFilter Field:=7, Criteria1:="1"
son = Workbooks("Kitap1.xls").Worksheets("Sayfa1").[A65536].End(3).Row
aktarılacak = Workbooks("Kitap1.xls").Worksheets("sayfa1").["F2:F & SON]
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("C:\Auto.txt", True)
For i = 2 To son
If Sheets("Sayfa1").Cells(i, "F").EntireRow.Hidden = False Then
    a.writeline Sheets("Sayfa1").Cells(i, "F").Value
End If
Next
a.Close
End Sub

 

[frtnamu]

çok teşekkürler Sayın Evren Gizlen elinize emeğinize sağlık.

 

[Orion1]

çok teşekkürler Sayın Evren Gizlen elinize emeğinize sağlık.

Rica ederim.
İyi çalışmalar.