Data to new Workbook

[Midget]

Here is the problem, I have a worksheet in which there are 3 columns.
Column A contains the names of new workbooks, Column B contains the
names of the new worksheets within the new workbook, and Column C
contains the data for each worksheet within the workbook. My data
looks something like the following...
A B C
1 Close F Street A3590 Removals
2 A3600 Road Exc.
3 Temp Tie In A3630 Removals
4 A3640 Road Exc.
5 Connect to D Street A3660 Removals.

Is what I am trying to do even possible? To re-explain this with the
example above...
I want this to create a new Workbook called Close F Street, that
workbook will have 2 worksheets called A3590 and A 3600, and The
column C data will be in Cell 18, so Sheet A3590 will have Removals in
Cell 18 and Sheet A3600 will have Road Exc. in Cell 18.

I hope this makes sense. I have tried to accomplish this on my own
but can't get anywhere.

Thanks for your response.

Ryan

 

[Guest]

Your explanation is a little confusing.
Is the worksheet you are illustrating as an example included in one of the
new workbooks or is it to be an index to the new workbooks, making it a
fourth workbook? The active workbook plus three new workbooks as illustrated?
The illustration indicates thay Column A in the new workbooks might be have
vertically merged cells, is that what you have done so that the worksheets
are easily identified to their workbooks, or is it just a manual index
listing?
When you refer to cell 18, which worksheets are you referring to and what
column would that cell be found in, A, B or C? or other?

If you can be a little more clear in your explanation, I am sure someone
will help you.

 

[Guest]

Assumes your data starts in A1 of the Activesheet when you run the macro.

Make custom changes as indicated in the macro.

Sub CreateBooks()
Dim sh As Worksheet, bk As Workbook
Dim shNew As Long, rng As Range, rng1 As Range
Dim cell As Range, cell1 As Range
Dim rStart As Range, sName As String
Dim rw As Long, sPath As String
Dim i As Long

' Change the next line to reflect your path

sPath = "C:\Data2\Test\"


Set sh = ActiveSheet
shNew = Application.SheetsInNewWorkbook
Set rng = sh.Range("A1", sh.Cells(Rows.Count, 2).End(xlUp).Offset(1, -1))
rw = rng.Rows(rng.Rows.Count).Row
Set rStart = rng(1).Offset(0, 1)
sName = rng(1).Value & ".xls"
For Each cell In rng
If Not IsEmpty(cell) Or cell.Row = rw Then
If cell.Row <> 1 Then
Set rng1 = sh.Range(rStart, cell.Offset(-1, 1))
Application.SheetsInNewWorkbook = rng1.Rows.Count
Workbooks.Add
Set bk = ActiveWorkbook
i = 0
For Each cell1 In rng1
i = i + 1
With bk.Worksheets(i)
'
' change "C18" to reflect whatever you meant by "Cell 18"
'
.Range("C18").Value = cell1.Offset(0, 1)
.Name = cell1.Value
End With
Next
bk.SaveAs sPath & sName
bk.Close SaveChanges:=False
sName = cell.Value & ".xls"
Set rStart = cell.Offset(0, 1)
End If
End If
Next
End Sub