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

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
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.
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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?
 
Upvote 0
It surely is.
can i split the text in col a to add a D after the 3 letter codes.

thanks.

mike.
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,697
Members
448,293
Latest member
jin kazuya

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