multiple files from one file

[Darius]

Hi there;
I have a file with below structure:
A1: name
A2:E93 contain data
then
A94: name
A95:E186 contain data
then again
continues till:
A5860: name
A5861:E5952 contain data

each set of data are 91 cells (in a coulmn) after each set there is one row
which in its A column is name. Now what I want is how to make an Excel file
for each 91 set of data (91 Col., 5 Rows) and save them with the names comes
in A cell for that data came as name. So basically I shoudl have many files
which contain just one set of data and keep the original file as it is?
Appreciate any help for this.
Best
Darius

 

[Dave Peterson]

This worked ok for me:

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim newWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim myStep As Long
Dim myCols As Long

myStep = 91
myCols = 5

Set wks = Worksheets("Sheet1")

Set newWks = Workbooks.Add(1).Worksheets(1)

With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow Step myStep
.Cells(iRow + 1).Resize(myStep, myCols).Copy _
Destination:=newWks.Range("a1")
Application.DisplayAlerts = False
newWks.Parent.SaveAs _
Filename:="C:\temp\" & .Cells(iRow, "A").Value & ".xls", _
FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True
newWks.UsedRange.Clear
Next iRow
End With

newWks.Parent.Close savechanges:=False

End Sub

I put the files in C:\temp. That folder has to exist.

And any existing files with the same name are overwritten with the new file.
Application.displayalerts stops excel from prompting you.

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

 

[Dave Peterson]

Actually, that didn't work ok for me.

But this one did:

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim newWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim myStep As Long
Dim myCols As Long

myStep = 91
myCols = 5

Set wks = Worksheets("Sheet1")

With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow Step myStep
Set newWks = Workbooks.Add(1).Worksheets(1)
.Cells(iRow + 1, "A").Resize(myStep, myCols).Copy _
Destination:=newWks.Range("a1")
Application.DisplayAlerts = False
newWks.Parent.SaveAs _
Filename:="C:\temp\" & .Cells(iRow, "A").Value & ".xls", _
FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True
newWks.Parent.Close savechanges:=False
Next iRow
End With


End Sub