Create a text file and paste some specific data from a sheet into a renamed sheet

Question

I have written a basic code in VB to filter out a specific text ("FIN") which I have to write in a .txt file and rename it using string from a cell in the same workbook but different sheet. Below is the code i prepared to filter out and it works but I am stuck at the saving and renaming part.

Sub SAVE()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim Lastrow As Long
Set WS1 = Sheets("WORKING")
Set WS2 = Sheets("FINAL")

WS2.Cells.Delete
WS1.AutoFilter.ShowAllData
WS1.Range("B1:C50000").AutoFilter Field:=2, Criteria1:="<>FIN"
Lastrow = WS1.Cells(Rows.Count, "B").End(xlUp).Row
WS1.Range("B1:B" & Lastrow).SpecialCells(xlCellTypeVisible).Copy WS2.Range("A1")
Sheets("FINAL").Select
Range("A1:A & Lastrow").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Is this question about VBA or VB.NET? The descriptions of both tags specifically tell you not to use one for the other. Please fix your tags. — jmcilhinney, Aug 20 '23 at 12:44
This should give you a start ... https://davetallett26.github.io/excel-markdown.html — user10186832, Aug 20 '23 at 12:44
"string from a cell in the same workbook" - which cell on which sheet ? — CDP1802, Aug 20 '23 at 13:59
`Range("A1:A & Lastrow").Select` should be `Range("A1:A" & Lastrow).Select` — CDP1802, Aug 20 '23 at 14:26

score 0 · Answer 1 · answered Aug 20 '23 at 15:12

Option Explicit

Sub SaveAsText()

    Dim ws1 As Worksheet, ws2 As Worksheet, fso As Object, ts As Object
    Dim lastrow As Long, i As Long, n As Long
    Dim textfile As String, ar
    Dim t0 As Single: t0 = Timer
    
    Set ws2 = Sheets("Final")
    ws2.Cells.Delete
    
    ' copy filtered data to FINAL
    Set ws1 = Sheets("WORKING")
    With ws1
        .AutoFilterMode = False
        lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
        .Range("B1:C1").AutoFilter Field:=2, Criteria1:="<>FIN"
        .Range("B1:B" & lastrow).SpecialCells(xlCellTypeVisible).Copy ws2.Range("A1")
        .AutoFilterMode = False
    End With
    
    ' create text file
    textfile = "textfile.txt" ' = Sheets("?").Range("?")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.CreateTextFile(textfile)
    
    With ws2
        ar = .UsedRange
        n = UBound(ar)
        For i = 1 To n
            ts.writeline ar(i, 1)
        Next
    End With
    ts.Close
    
    MsgBox n & " records written to " & textfile, _
           vbInformation, Format(Timer - t0, "0.0 secs")
    
End Sub

PSP · Answer 2 · 2023-08-21T10:27:15.173

Sub SAVE_LM()

'Define all variables

Dim WS1 As Worksheet, WS2 As Worksheet
Dim LastRow As Long
Set WS1 = Sheets("WORKING")
Set WS2 = Sheets("FINAL")
Const Forwriting = 2
Dim EXCELPATH As String
Dim NAME As String

'File name create from name
NAME = ThisWorkbook.Names("NAME").RefersToRange.Value & ".FHX"

'FIle path same as the excel path
EXCELPATH = Application.ThisWorkbook.PATH

'Create .txt file and save as .fhx
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim FileName As String
FileName = NAME
strfullname = objFSO.BuildPath(EXCELPATH, FileName)
Set objFile = objFSO.CreateTextFile(strfullname)
objFile.Close

'Write all the code for fhx from the working sheet into the Final_FHX sheet 
removing FIN
WS2.Cells.Delete
WS1.AutoFilter.ShowAllData
WS1.Range("B1:C20000").AutoFilter Field:=2, Criteria1:="<>FIN"
LastRow = WS1.Cells(Rows.Count, "B").End(xlUp).Row
WS1.Range("B1:B" & LastRow).SpecialCells(xlCellTypeVisible).Copy WS2.Range("A1")
Sheets("FINAL_FHX").Select
Range("A1:A" & LastRow).Select
Range(Selection, Selection.End(xlDown)).Select

'Write the code from FINAL into the .TXT file and save as .FHX file
Dim PATH As String
PATH = objFSO.BuildPath(EXCELPATH, FileName)
Open PATH For Output As #1
        For i = 1 To LastRow
            Print #1, Cells(i, 1)
            Next i
    Close #1
    
'Change focus to Info sheet
ThisWorkbook.Worksheets("INFO").Activate


End Sub

Your answer could be improved with additional supporting information. Please [edit] to add further details, such as citations or documentation, so that others can confirm that your answer is correct. You can find more information on how to write good answers [in the help center](/help/how-to-answer). — Community, Aug 21 '23 at 15:27

Create a text file and paste some specific data from a sheet into a renamed sheet

2 Answers2