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
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

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"
 

Forum statistics

Threads
1,147,515
Messages
5,741,615
Members
423,674
Latest member
Charles2dodo

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
Top