save each row as name of col A why does PRN freeze it

excelent

Board Regular
Joined
Sep 7, 2002
Messages
105
Hi group.
I am trying to create a macro that will save each row in the sheet(only1 sheet in the work book) as a text file in the name of the text in column A, this column has different names down the column. it will also need to start from the first row, no headers in the list.
so if there were 100 rows it should be able to save 100 text files in a folder e.g. C:testing


the formula below, (from this site) saves each sheet as a text file in the 1 folder, and have tried to modify it for saving each row of only 1 sheet with No luck

Sub SaveSheets()
Const MyPath = "C:\Testing\"
Dim Sh As Worksheet
Dim FName As String
For Each Sh In ThisWorkbook.Worksheets
FName = MyPath & Sh.Range("A2").Text
Sh.Copy
ActiveWorkbook.SaveAs Filename:=FName, FileFormat:=xlTextwindows
ActiveWorkbook.Close Savechanges:=False
Next Sh
End Sub


thanks

mike.
This message was edited by excelent on 2002-09-16 01:52
 

Some videos you may like

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Post an example of your data and specify exactly what you want to save to the text file.
 

excelent

Board Regular
Joined
Sep 7, 2002
Messages
105
Hi andrew

there are 6 columns
the data in b to g are normally different values buy this should do as an example.
column a has different text .
only each rows data (A to G) will be saved in each created file.


A B c d e f g

AAC 100 100 100 100 100 100
AAI 100 100 100 100 100 100
AAR 100 100 100 100 100 100
AAT 100 100 100 100 100 100
AAU 100 100 100 100 100 100



i found a similar post but it saves columns.
Sub ColExport2()

Dim MaxCol As Integer, MyCol As Integer


' Find last column in sheet
' This returns the same values as hitting End Home / Ctrl+End
MaxCol = ActiveSheet.Cells.SpecialCells(xlLastCell).Column

' Start Column
MyCol = 1

Do Until MyCol = MaxCol + 1

' Get Column name
ColName = Cells(1, MyCol).Value

' Translate to full file + path (change as necessary)
ColFilename = "C:temp" & ColName & ".txt"

' Check to see if it exists
ChkFile = Dir(ColFilename, vbNormal)
If ChkFile <> "" Then
DoubleCheck = MsgBox("The file " & ChkFile & " already exists. Do you want to replace the existing file?", vbYesNo + vbExclamation)
End If

' Delete existing file if overwrite is confirmed
If DoubleCheck = vbYes Then
Kill (ColFilename)
End If

' Create the output file if we have a filename and have verified it's ok.
If DoubleCheck <> vbNo Then

' Copy column
Range(Cells(2, MyCol), Cells(Cells(65536, MyCol).End(xlUp).Row, MyCol)).Copy

Workbooks.Add
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=ColFilename, FileFormat:=xlText, _
CreateBackup:=False
ActiveWorkbook.Close False

End If
MyCol = MyCol + 1
DoubleCheck = Empty
Loop
End Sub

thanks.

mike.
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Try this:

Code:
Sub SaveRows()
    Const MyPath = "C:Testing"
    Dim Rng As Range
    Dim x As Long
    Dim FName As String
    Set Rng = Range("A1").CurrentRegion
    Application.ScreenUpdating = False
    For x = 1 To Rng.Rows.Count
        FName = MyPath & Rng.Cells(x, 1).Text
        Rng.Cells(x, 1).EntireRow.Copy
        Workbooks.Add
        ActiveSheet.Paste
        ActiveWorkbook.SaveAs Filename:=FName, FileFormat:=xlTextWindows
        ActiveWorkbook.Close Savechanges:=False
    Next x
    Application.ScreenUpdating = True
End Sub
 

excelent

Board Regular
Joined
Sep 7, 2002
Messages
105

ADVERTISEMENT

Thanks andrew.

The macro freezes when trying to do about 2000 rows. It stops saving at row number 1687.
Is there a way to save a large row in smaller steps.

Apart from this its perfect.


Thankyou.
mike.
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
I don't know why that should be, but I haven't tested it.

This will save 100 rows starting at the active cell:

Code:
Sub SaveRows()
    Const MyPath = "C:Testing"
    Dim Rng As Range
    Dim x As Long
    Dim FName As String
    Set Rng = ActiveCell
    Application.ScreenUpdating = False
    For x = 1 To 100
        If IsEmpty(Rng.Cells(x, 1)) Then Exit Sub
        FName = MyPath & Rng.Cells(x, 1).Text
        Rng.Cells(x, 1).EntireRow.Copy
        Workbooks.Add
        ActiveSheet.Paste
        ActiveWorkbook.SaveAs Filename:=FName, FileFormat:=xlTextWindows
        ActiveWorkbook.Close Savechanges:=False
    Next x
    Application.ScreenUpdating = True
End Sub
 

excelent

Board Regular
Joined
Sep 7, 2002
Messages
105

ADVERTISEMENT

sorry andrew the problem is with a name in col A

The text PRN can this stop the macro running.

i had deleted columns to the point where it frooze and its always PRN in col A
the previous row was PRM and it saved this.

Is PRN something excel uses itself.

thanks.

mike.
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Yes, but I think Windows not Excel.

If I try to do this manually I get the following error "The file name prn.txt is a reserved device name."

That's a nuisance isn't it?
 

excelent

Board Regular
Joined
Sep 7, 2002
Messages
105
It surely is.
can i split the text in col a to add a D after the 3 letter codes.

thanks.

mike.
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Replace the line of code which sets the file name with:

Code:
FName = MyPath & Rng.Cells(x, 1).Text & "D"
 

Watch MrExcel Video

Forum statistics

Threads
1,118,388
Messages
5,571,842
Members
412,420
Latest member
grace_abar
Top