Make a macro to create multiple Excel Files

[lmcate2]

I have an Excel File that has many columns see below for layout. I want to create an excel files for each of the companies. For Example Hilton HOtels may have 10 lines and I want to create an Excel file containing all the fields from he master file.

Hotel Name Code Address city state zip
Hilton Hotels HH 132 Main Street, City, State, Zip....
Hilton Hotels HH 132 Main Street, City, State, Zip....
Hilton Hotels HH 132 Main Street, City, State, Zip....
Hilton Hotels HH 132 Main Street, City, State, Zip....
Hilton Hotels HH 132 Main Street, City, State, Zip....
Ramada Hotels RA 434 Main Street, City, State, Zip....
Ramada Hotels RA 434 Main Street, City, State, Zip....
Ramada Hotels RA 434 Main Street, City, State, Zip....
Hilton Hotels HH 132 Main Street, City, State, Zip....
Hilton Hotels HH 132 Main Street, City, State, Zip....

Thanks your all you great help.

Sam

 

[GlennUK]

Are you telling the whole story? How many rows in the Master? Do you want to split the Master, or have connections back to it? Why can't you cut and paste? Do you want this as a one-off, or a repeatable process?

Cheers, Glenn.

Did you hear about the literalist show-jumper? He broke his nose jumping against the clock.

 

[scotsql]

you could create a sheet for each hotel then embed a query into that sheet specifying which hotel to pick up....

 

[KenWright]

What data are you summarising?, ie what is in the other columns. What is the aim ofw hat you are doing, and what kind of output are you looking to be able to get from the data?

Regards
Ken.............

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission
---------------- Click here to help the tsunami victims ----------------

 

[KenWright]

What data are you summarising?, ie what is in the other columns. What is the aim ofw hat you are doing, and what kind of output are you looking to be able to get from the data?

Regards
Ken.............

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission
---------------- Click here to help the tsunami victims ----------------

 

[lmcate2]

I have the master file with about 700 lines and i want to create independent eXcel files for each of the hotels.

thanks,

Sam

 

[Dsuperc]

Sub FanOut()
Dim ColHead As String
Dim ColHeadCell As Range
Dim iCol As Integer
Dim iRow As Long
Dim lRow As Integer
Dim NewWB() As Workbook
Dim Fsheet As Worksheet
Dim Answer As Variant
Dim i As Integer

Again:
ColHead = InputBox("Enter Column Heading", "Identify Column", [H1].Value)
If ColHead = "" Then Exit Sub
Set ColHeadCell = Rows(1).Find(ColHead, lookat:=xlWhole)
If ColHeadCell Is Nothing Then
MsgBox "Heading not found in row 1"
GoTo Again
End If

Set Fsheet = ActiveSheet
ReDim NewWB(0)

iCol = ColHeadCell.Column
'loop through values in selected column
For iRow = 2 To Fsheet.Cells(65536, iCol).End(xlUp).Row
If Not BookExists(CStr(Fsheet.Cells(iRow, iCol).Value)) Then
ReDim Preserve NewWB(UBound(NewWB) + 1)
Set NewWB(UBound(NewWB)) = Workbooks.Add
NewWB(UBound(NewWB)).SaveAs Fsheet.Cells(iRow, iCol)
Set Dsheet = NewWB(UBound(NewWB)).Sheets(1)
Fsheet.Rows(1).Copy Destination:=Dsheet.Rows(1)
Dsheet.Name = CStr(Fsheet.Cells(iRow, iCol).Value)
Else
Set Dsheet = Workbooks(CStr(Fsheet.Cells(iRow, iCol).Value) & ".xls").Sheets(1)
End If
lRow = Dsheet.Cells(65536, iCol).End(xlUp).Row
Fsheet.Rows(iRow).Copy Destination:=Dsheet.Rows(lRow + 1)
Next iRow

Answer = MsgBox("Would you like all the fanned out files closed?", _
vbQuestion + vbYesNo, UBound(NewWB) & " Files Created")
If Answer = vbYes Then
For i = 1 To UBound(NewWB)
NewWB(i).Close savechanges:=True
Next i
End If

End Sub

Function BookExists(BookId As Variant) As Boolean


Dim Wb As Object
On Error GoTo NoSuch
Set Wb = Workbooks(BookId & ".xls")
BookExists = True
Exit Function
NoSuch:
If Err = 9 Then BookExists = False Else Stop

End Function