Macro to create .txt files with the names present in cell

[khalidness]

Hi All,


I have data in column A, I need a macro that creates .txt files with data present in each cell A and repeat the process till the end of file.


e.g My Sheet :


A1 = ABC
A2 = BG2


Expected Out


Files ABC.txt and BG2.txt should be created.


Kindly do the needful.

 

[Domenic]

Assuming that the sheet containing the data is the active sheet, try...

[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit
[/COLOR]
[COLOR=darkblue]Sub[/COLOR] CreateTextFiles()

    [COLOR=darkblue]Dim[/COLOR] sPath           [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] sFile           [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] sText           [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] LastRow         [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] i               [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=darkblue]If[/COLOR] TypeName(ActiveSheet) <> "Worksheet" [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    
    sPath = "C:\Users\Domenic\Desktop\" [COLOR=#006400]'change the name of the destination folder accordingly[/COLOR]
    [COLOR=darkblue]If[/COLOR] Len(Dir(sPath, vbDirectory)) > 0 [COLOR=darkblue]Then[/COLOR]
        [COLOR=darkblue]If[/COLOR] Right(sPath, 1) <> "\" [COLOR=darkblue]Then[/COLOR] sPath = sPath & "\"
    [COLOR=darkblue]Else[/COLOR]
        MsgBox "No folder found.", vbExclamation
        [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    [COLOR=darkblue]For[/COLOR] i = 1 [COLOR=darkblue]To[/COLOR] LastRow
        sText = Cells(i, "A").Value
        [COLOR=darkblue]If[/COLOR] Len(sText) > 0 [COLOR=darkblue]Then[/COLOR]
            sFile = sText & ".txt"
            [COLOR=darkblue]Open[/COLOR] sPath & sFile [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Output[/COLOR] [COLOR=darkblue]As[/COLOR] #1
            [COLOR=darkblue]Close[/COLOR] #1
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] i
    
    MsgBox "Completed...", vbInformation
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Hope this helps!