Txt dosyasına aktarma

[yusuf1284]

Excelde veri sayısı dinamik amacım exceldeki TC leri txt dosyasına aktarmak aşağıda ki kod işe yaramakta fakat son satıra boş satır ekliyor bunu eklemesini nasıl engellerim veya nasıl silebilirim?

Sub txtCreate()
    Dim s1 As Worksheet
    Dim arr As Variant
    Dim data As String, file As String
    Dim lastRow As Long, i As Long, j As Long, z As Long
    Dim d As Object
    
    Set s1 = ThisWorkbook.Worksheets(sh_JasbisSonuc.Name)
    Set d = CreateObject("Scripting.Dictionary")
    lastRow = s1.Cells(s1.Rows.count, "e").End(3).Row
    
    Dim dataColumn As Range
    Set dataColumn = s1.Range("A7:A9999")
    
    Dim folderPath As String
    folderPath = ThisWorkbook.Path & "\Sorgulanacaklar"
    
    If Dir(folderPath, vbDirectory) = vbNullString Then
        MkDir folderPath
    End If
    
    Dim fileName As String
    fileName = Dir(folderPath & "\*.txt")
    While fileName <> ""
        Kill folderPath & "\" & fileName
        fileName = Dir()
    Wend
    
    Dim count As Long
    
    For Each Cell In s1.Range("E7" & ":" & "E" & lastRow)
        If Not d.Exists(Cell.Value) Then
            If Cell.Value <> "" Then
                d.Add Cell.Value, Nothing
            End If
        End If
    Next
    
    count = d.count
    For i = 0 To count - 1 Step 499
        data = ""
        For j = i To i + 498
            If j > count - 1 Then Exit For
            data = data & d.Keys()(j)
            If j <> i + 498 And j < count - 1 Then
                data = data & vbNewLine
            End If
        Next
        
        If j = count - 1 Then
            data = Left(data, Len(data) - 1)
        End If
        
        file = ThisWorkbook.Path & "\Sorgulanacaklar\" & Int((i + 1) / 499 + 1) & ". Grup" & "_" & i + 1 & "-" & j & ".txt"
    
        If Dir(file) = "" Then
            Open file For Output As #1
            Print #1, data
            Close #1
        Else
            Kill ThisWorkbook.Path & "\Sorgulanacaklar\*.txt"
            Open file For Output As #1
            Print #1, data
            Close #1
        End If
    Next
End Sub

 

[yusuf1284]

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object

If Dir(file) = "" Then
    Set oFile = fso.CreateTextFile(file)
    oFile.Write data
    oFile.Close
Else
    Kill ThisWorkbook.Path & "\Sorgulanacaklar\*.txt"
    Set oFile = fso.CreateTextFile(file)
    oFile.Write data
    oFile.Close
End If

Bu şekilde çözdüm teşekkür ederim.