Excel VBA to Export individual cells to *.txt file

[miserief]

Hi all!

This is my first post so bare with me

I need some help with a VBA to export the value in all the cells from Column G into individual .txt files. The name of the text should be "Answer" Value in Column A. It all needs to be saved in the same directory as the Excel file itself.
What I have now is:

'Copy the contents of a worksheet, and save it as  a .txt fileSub CopyToTxt()
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wbDest As Workbook
Dim fName As String

'References
Set wbSource = ActiveWorkbook
Set wsSource = ActiveSheet
Set wbDest = Workbooks.Add

wsSource.Range("G4:G4").Copy

wbDest.Worksheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

fName = ThisWorkbook.Path & "\answer.txt"

wbDest.SaveAs fName, xlText

wbDest.Close SaveChanges:=True


End Sub

I hope someone can help me! Sorry if I put this post in the wrong place!

Thanks!
Martijn

 

[AlphaFrog]

Try this...

    [color=darkblue]Dim[/color] cell [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] FF [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] Counter [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] cell [color=darkblue]In[/color] Range("G1", Range("G" & Rows.Count).End(xlUp))
        [color=darkblue]If[/color] cell.Value <> "" And Range("A" & cell.Row).Value <> "" [color=darkblue]Then[/color]
            FF = FreeFile()
            [color=darkblue]Open[/color] ThisWorkbook.Path & "\" & Range("A" & cell.Row).Value & ".txt" [color=darkblue]For[/color] [color=darkblue]Output[/color] [color=darkblue]As[/color] #FF
            [color=darkblue]Print[/color] #FF, cell.Text
            [color=darkblue]Close[/color] #FF
            Counter = Counter + 1
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] cell
    
    MsgBox Counter & " files saved. ", , "Text Files Created"

 

[miserief]

Thanks Alphafrog! It works perfectly!

 

[Zahnrad Kopf]

Try this...

    [COLOR=darkblue]Dim[/COLOR] cell [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] FF [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] Counter [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] cell [COLOR=darkblue]In[/COLOR] Range("G1", Range("G" & Rows.Count).End(xlUp))
        [COLOR=darkblue]If[/COLOR] cell.Value <> "" And Range("A" & cell.Row).Value <> "" [COLOR=darkblue]Then[/COLOR]
            FF = FreeFile()
            [COLOR=darkblue]Open[/COLOR] ThisWorkbook.Path & "\" & Range("A" & cell.Row).Value & ".txt" [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Output[/COLOR] [COLOR=darkblue]As[/COLOR] [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF]#FF[/URL] 
            [COLOR=darkblue]Print[/COLOR] [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF]#FF[/URL] , cell.Text
            [COLOR=darkblue]Close[/COLOR] [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF]#FF[/URL] 
            Counter = Counter + 1
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] cell
    
    MsgBox Counter & " files saved. ", , "Text Files Created"

Pardon the Seven and One Half year old necro-thread. I've arrived here via a google search and think that this might be relevant to my search.

This answer is almost what I need, but I need to save several cells that are not neatly arranged in columns, and next to each other. ( neither the rows, nor the columns )

Is it possible to perform this same thing on cells that are so separated? The data is basically in Four different columns, but not arranged in rows that are neatly next to each other. Their locations never change, so I am fine with the idea of hard coding their locations in. I simply have no idea of how to accomplish this. Can this be done?

Thank you for your time.

 

[Rick Rothstein]

Pardon the Seven and One Half year old necro-thread. I've arrived here via a google search and think that this might be relevant to my search.

This answer is almost what I need, but I need to save several cells that are not neatly arranged in columns, and next to each other. ( neither the rows, nor the columns )

Is it possible to perform this same thing on cells that are so separated? The data is basically in Four different columns, but not arranged in rows that are neatly next to each other. Their locations never change, so I am fine with the idea of hard coding their locations in. I simply have no idea of how to accomplish this. Can this be done?

What are the cell addresses?

 

[Zahnrad Kopf]

What are the cell addresses?

K24, L24, L24, M24, P24, Q24, R24, S24,
K25, L25, L25, M25, P25, Q25, R25, S25
K26, L26, L26, M26, P26, Q26, R26, S26,

K28, L28, L28, M28, P28, Q28, R28, S28,
K29, L29, L29, M29, P29, Q29, R29, S29,
K30, L30, L30, M30, P30, Q30, R30, S30,

K32, L32, L32, M32, P32, Q32, R32, S32,
K33, L33, L33, M33, P33, Q33, R33, S33,
K34, L34, L34, M34, P34, Q34, R34, S34,

K36, L36, L36, M36, P36, Q36, R36, S36,
K37, L37, L37, M37, P37, Q37, R37, S37,
K38, L38, L24, M24, P24, Q24, R24, S24,

K40, L40, L40, M40, P40, Q40, R40, S40,
K41, L41, L41, M41, P41, Q41, R41, S41,
K42, L42, L42, M42, P42, Q42, R42, S42,

K44, L44, L44, M44, P44, Q44, R44, S44,
K45, L45, L45, M45, P45, Q45, R45, S45,
K46, L46, L46, M46, P46, Q46, R46, S46.

Why?

Thank you.

 

[Zahnrad Kopf]

Apologies. Somehow I lost the formatting that I desired in my previous reply. ( forum software is also removing the capitalization )

This is how it should look when exported.

Thanks.



k24, l24,
k25, l25,
k26, l26,

k28, l28,
k29, l29,
k30, l30,

k32, l32,
k33, l33,
k34, l34,

k36, l36,
k37, l37,
k38, l38,

k40, l40,
k41, l41,
k42, l42,

k44, l44,
k45, l45,
k46, l46,

r24, s24,
r25, s25
r26, s26,

r28, s28,
r29, s29,
r30, s30,

r32, s32,
r33, s33,
r34, s34,

r36, s36,
r37, s37,
r38, s38,

r40, s40,
r41, s41,
r42, s42,

r44, s44,
r45, s45,
r46, s46,

l24, m24,
l25, m25,
l26, m26,

l28, m28,
l29, m29,
l30, m30,

l32, m32,
l33, m33,
l34, m34,

l36, m36,
l37, m37,
l38, m38,

l40, m40,
l41, m41,
l42, m42,

l44, m44,
l45, m45,
l46, m46,

p24, q24,
p25, q25,
p26, q26,

p28, q28,
p29, q29,
p30, q30,

p32, q32,
p33, q33,
p34, q34,

p36, q36,
p37, q37,
p38, q38,

p40, q40,
p41, q41,
p42, q42,

p44, q44,
p45, q45,
p46, q46,

 

[Zahnrad Kopf]

Anyone? I'm at a loss with it. Thank you for any input you may have.