exporting excel columns to multiple txt files, if theres data

jlm55

New Member
Joined
Mar 10, 2010
Messages
4
I have an excel doc with 7 (a-g)columns data(data is formulas if that matters), each column has a header (10 rows from cell 1-10) and is 45 rows deep of data (cells 20-65) and after the 45 rows there are 2 rows of formatting i need to enter. I need a seperate TXT file for each column (or set of 45 rows).

I need a macro that will look in each of the rows and first see if there is data, so it will only export if there is data to export. then it needs to know where the data ends and in which column as each column needs to export to its own TXT file.

Finally, I need it to say end and end file in the last two rows 46 and 47 in the txt file for each file.

currently im using this code, but it isnt working:

Code:
Option Explicit

Sub SaveColumnsToText()
'Save each column to separate text file
Dim LR As Long, dCol As Long, Cnt As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False

dCol = 1:   Cnt = 1

Do
    If Application.WorksheetFunction.CountA(Columns(dCol)) Then
        Columns(dCol).Copy
        Workbooks.Add
        Range("A1").PasteSpecial xlPasteAll
        Range("A" & Rows.count).End(xlUp).Offset(1, 0) = "END-OF-DATA"
        Range("A" & Rows.count).End(xlUp).Offset(1, 0) = "END-OF-FILE"
        ActiveWorkbook.SaveAs Filename:="filename", FileFormat:=xlText, CreateBackup:=False
        ActiveWorkbook.Close False
        dCol = dCol + 1
        Cnt = Cnt
    Else
        Exit Do
    End If
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

If anyone has any insight it would help alot
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
heres teh code im currently using, but its returning multiple files.

Can anyone help with a variable to make the loop only build files for rows where there is data in teh 20th row? check link for attached files

Code:
Sub SaveColumnsToText()
'saves each column to a separate text file
Dim LR As Long, dCol As Long, Cnt As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False



dCol = 1: Cnt = 1


Do
    LR = Cells(Rows.count, dCol).End(xlUp).Row
    If LR > 10 Then
        Columns(dCol).Copy
        Workbooks.Add
        Range("A1").PasteSpecial xlPasteValues
        Range("A" & Rows.count).End(xlUp).Offset(1, 0) = "END-OF-DATA"
        Range("A" & Rows.count).End(xlUp).Offset(1, 0) = "END-OF-FILE"
        ActiveWorkbook.SaveAs "filename" & Cnt, FileFormat:=xlText, CreateBackup:=False
        ActiveWorkbook.Close False
        dCol = dCol + 1
        Cnt = Cnt + 1
    Else
        Exit Do
    End If
Loop


Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub
 
Upvote 0

Forum statistics

Threads
1,215,815
Messages
6,127,035
Members
449,355
Latest member
g wiggle

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top