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

[excelent]

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

 

[excelent]

Youre fast andrew.
What a great forum.
no problem now.

thanks.
mike.

 

[excelent]

Hi again.

I have a new prob now and need to create a headers, due to metastock ticker data needing a header for the conversion.
so far i have a macro that creates a blank row in between every row with data which i need to fill with text as below
<TICKER>,<PER>,<DTYYYYMMDD>,<TIME>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>,<OPENINT>

do i need to change the 1 to 2 in your previous line of code,
For x = 1 To Rng.Rows.Count to save 2rows in each file so it contains the headers and the 1 row of data.

thanks.
mike.

 

[Andrew Poulsom]

Well you're almost right:

Sub SaveRows2()
    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 Step 2
        FName = MyPath & Rng.Cells(x, 1).Text
        Rng.Cells(x, 1).EntireRow.Resize(2).Copy
        Workbooks.Add
        ActiveSheet.Paste
        ActiveWorkbook.SaveAs Filename:=FName, FileFormat:=xlTextWindows
        ActiveWorkbook.Close Savechanges:=False
    Next x
    Application.ScreenUpdating = True
End Sub

 

[excelent]

it did the trick.

thanks .

mike.