Inserting column headers text before the content of each cell in a column

Hi,

I'm a complete novice at Excel VBA so please forgive me if this is something easy.

I have a spreadsheet in the format below:

Column 1:	Column 2:	Column 3:
Dave	1	a
Mike	2	b
Jon	3	c

I have some code that I managed to adapt from a previous thread that extracts the content of each row and saves it to individual text files. The only problem is that without the column headers I can't tell what some of the data means. I need a way to insert/concatenate the column headers with the content of their columns before it starts extracting the rows into separate files eg A2 would say "Column 1: Dave"

Below is the code I have to extract the data into text files.

Sub Export_to_individual_files_with_carriage_return()
Dim r As Range, r2 As Range
Dim ff As Integer
Dim s As String

For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
s = ""
For Each r2 In Range(r, Cells(r.Row, Columns.Count).End(xlToLeft))
If VarType(r2) = vbString Then
s = s & Chr(10) & "" & r2.Value & ""
Else
s = s & Chr(10) & r2.Value
End If
Next r2
s = Right(s, Len(s) - 1)
ff = FreeFile
Open ThisWorkbook.Path & "\" & r.Value & ".txt" For Output As #ff
Print #ff, s
Close #ff
Next r
End Sub

Any help you can offer would be appreciated.

Thanks

Thanks for reply.

That doesn't quite work. In the file it extracts it gave me a first cell that said "Dave: Dave" and doesn't do anything to subsequent cells.

I changed r.row to r.column and that gives me "Column 1: Dave" which is what I want. However it only does this for the data in the first column.

Thanks

Thank you,

Is there any particular way to send it to you?

The data in the spreadsheet is all made up test data so you could just mock something up and create a macro using the code below:


Sub Export_to_individual_files_with_carriage_return()
Dim r As Range, r2 As Range
Dim ff As Integer
Dim s As String

For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
s = Range("a" & r.Column).Value
For Each r2 In Range(r, Cells(r.Row, Columns.Count).End(xlToLeft))
If VarType(r2) = vbString Then
s = s & Chr(10) & "" & r2.Value & ""
Else
s = s & Chr(10) & r2.Value
End If
Next r2
s = Right(s, Len(s) - 1)
ff = FreeFile
Open ThisWorkbook.Path & "\" & r.Value & ".txt" For Output As #ff
Print #ff, s
Close #ff
Next r
End Sub