I have a file with almost 11K rows. I need to take those rows an
create a new sheet for each group. Each group has a unique number, bu
there are an addition 7 columns that will need to be moved as well...
There are a total of 833 groups.

For example (the '...' represent the remaining columns)

One sheet:

10 ABC ...
10 ABC ...
20 EFG ...
20 EFG ...
20 EFG ...
20 EFG ...
30 QRS ...
30 QRS ...
30 QRS ...

I would want three sheets:

Sheet A =
10 ABC ...
10 ABC ...

Sheet B =
20 EFG ...
20 EFG ...
20 EFG ...
20 EFG ...

Sheet C =
30 QRS ...
30 QRS ...
30 QRS ...

Thanks for any help!!!

Hillar

-----------------------------------------------
~~ Message posted from http://www.ExcelTip.com
~~View and post usenet messages directly from http://www.ExcelForum.com

hef

Subject line reads "one worksheet into two worksheets" then you say you want
to create a new sheet for each of 833 groups.

I'm usually not one to question why but......why would you want 833 sheets
with an average of 13 rows per sheet?

Wouldn't it be easier to keep all on one sheet then use Filtering to extract
groups as you need them?

In answer to your question........yes, it could be done. Do you really need
it to be done?

Gord Dibben XL2002

On Wed, 19 Nov 2003 15:31:22 -0600, hef
wrote:


I have a file with almost 11K rows. I need to take those rows and
create a new sheet for each group. Each group has a unique number, but
there are an addition 7 columns that will need to be moved as well...
There are a total of 833 groups.

For example (the '...' represent the remaining columns)

One sheet:

10 ABC ...
10 ABC ...
20 EFG ...
20 EFG ...
20 EFG ...
20 EFG ...
30 QRS ...
30 QRS ...
30 QRS ...

I would want three sheets:

Sheet A =
10 ABC ...
10 ABC ...

Sheet B =
20 EFG ...
20 EFG ...
20 EFG ...
20 EFG ...

Sheet C =
30 QRS ...
30 QRS ...
30 QRS ...

Thanks for any help!!!

Hillary


------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~View and post usenet messages directly from http://www.ExcelForum.com/

Sort, cut, and paste.


"hef" wrote in message
...

I have a file with almost 11K rows. I need to take those rows and
create a new sheet for each group. Each group has a unique number, but
there are an addition 7 columns that will need to be moved as well...
There are a total of 833 groups.

For example (the '...' represent the remaining columns)

One sheet:

10 ABC ...
10 ABC ...
20 EFG ...
20 EFG ...
20 EFG ...
20 EFG ...
30 QRS ...
30 QRS ...
30 QRS ...

I would want three sheets:

Sheet A =
10 ABC ...
10 ABC ...

Sheet B =
20 EFG ...
20 EFG ...
20 EFG ...
20 EFG ...

Sheet C =
30 QRS ...
30 QRS ...
30 QRS ...

Thanks for any help!!!

Hillary


------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~View and post usenet messages directly from http://www.ExcelForum.com/

I have one file with information on 833 suppliers.

I have to send to each supplier a list of only their parts, have the
fill in one column and then send me their file back. I could send the
a hard copy...but then it would take me forever to compile the dat
when the information's returned.

We figured it would be easier to send each supplier their ow
spreadsheet. And then remerge the data when it is sent back. Hence th
reason I need 833 different sheets...

I know...what a pain. Although, at least I realized there had to be
quicker way then doing it maual (talk about a nightmare). ugh...

Thanks for any help in advance!!!

Hillar

-----------------------------------------------
~~ Message posted from http://www.ExcelTip.com
~~View and post usenet messages directly from http://www.ExcelForum.com

-----Original Message-----

I have a file with almost 11K rows. I need to take those
rows and
create a new sheet for each group. Each group has a
unique number, but
there are an addition 7 columns that will need to be
moved as well...
There are a total of 833 groups.

For example (the '...' represent the remaining columns)

One sheet:

10 ABC ...
10 ABC ...
20 EFG ...
20 EFG ...
20 EFG ...
20 EFG ...
30 QRS ...
30 QRS ...
30 QRS ...

I would want three sheets:

Sheet A =
10 ABC ...
10 ABC ...

Sheet B =
20 EFG ...
20 EFG ...
20 EFG ...
20 EFG ...

Sheet C =
30 QRS ...
30 QRS ...
30 QRS ...

Thanks for any help!!!

Hillary


------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~View and post usenet messages directly from
http://www.ExcelForum.com/

.
Hillary;

This is pretty complex and may be a paying deal. You a
VBA macro to parse through the 11,000 lines and then put
the groups into their own page.

Thanks,

Greg

If you have a workbook with 833 sheets in it how do you intend to sen
it to each company so that they get only there data


or are you really after 833 workbooks with 1 sheet in eac

-----------------------------------------------
~~ Message posted from http://www.ExcelTip.com
~~View and post usenet messages directly from http://www.ExcelForum.com

Here's a really chopped up version of a macro I use to send data to each
of our managers. Be warned that you'll have to do some modification. You
could also modify the section where I save to email it instead.

Sub CreatePMWorkbooks()

Dim wkbk As Workbook
Dim cell As Range
Dim colManagers As New Collection
Dim wsData As Worksheet
Dim ws As Worksheet
Dim vntManager As Variant
Dim lngNumRows As Long
Dim strName As String

Set wsData = ActiveWorkbook.Worksheets("Job Cost Summary")

Application.StatusBar = "Creating Workbooks. Please wait..."
Application.ScreenUpdating = False

'Count the number of rows
lngNumRows = wsData.Range("F65536").End(xlUp).Row

'Create a collection of managers
On Error Resume Next
For Each cell In wsData.Range("E6:E" & lngNumRows)
If cell.Value = "" Then cell.Value = "Unknown"
colManagers.Add cell.Value, CStr(cell.Value)
Next cell
On Error GoTo 0

'Filter on each manager and print
For Each vntManager In colManagers

Set wkbk = Application.Workbooks.Add

'Plug in each manager's name into the filter criteria range
wsData.Range("F2").Value = vntManager

'Add a new worksheet
wkbk.Sheets.Add befo=wkbk.Worksheets("Sheet1")
Set ws = ActiveSheet
ws.Name = vntManager

'Copy the field names from the original worksheet
wsData.Range("1:3").Copy ws.Range("1:3")

'Filter the data and copy to the new workbook
wsData.Range("A5").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, criteriarange:=wsData.Range("F1:F2"), _
copytorange:=ws.Range("A5")

'By default my new workbooks are created with 3 sheets
'This step deletes these sheets
If wkbk.Sheets.Count 3 Then
Application.DisplayAlerts = False
wkbk.Worksheets("Sheet1").Delete
wkbk.Worksheets("Sheet2").Delete
wkbk.Worksheets("Sheet3").Delete
Application.DisplayAlerts = True
End If

'Create a name for the workbook and save it
strName = "C:\Docs\Job Cost Summary " & vntManager
wkbk.SaveAs (strName)
wkbk.Close (False)

Next vntManager

'Clear my Filter Range
wsData.Range("F1:F2").Clear

LeaveSub:

Set colManagers = Nothing
Set cell = Nothing
Set wsData = Nothing
Set ws = Nothing

Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

In ,
hef typed:
I have one file with information on 833 suppliers.

I have to send to each supplier a list of only their parts, have them
fill in one column and then send me their file back. I could send
them a hard copy...but then it would take me forever to compile the
data when the information's returned.

We figured it would be easier to send each supplier their own
spreadsheet. And then remerge the data when it is sent back. Hence
the reason I need 833 different sheets...

I know...what a pain. Although, at least I realized there had to be a
quicker way then doing it maual (talk about a nightmare). ugh...

Thanks for any help in advance!!!

Hillary


------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~View and post usenet messages directly from
http://www.ExcelForum.com/

Hi Dianne,

please show me the structure of your datatable or send a workbook to me. I
got a mistake.
Thanks !

Volker

"Dianne" schrieb im Newsbeitrag
...
Here's a really chopped up version of a macro I use to send data to each
of our managers. Be warned that you'll have to do some modification. You
could also modify the section where I save to email it instead.

Sub CreatePMWorkbooks()

Dim wkbk As Workbook
Dim cell As Range
Dim colManagers As New Collection
Dim wsData As Worksheet
Dim ws As Worksheet
Dim vntManager As Variant
Dim lngNumRows As Long
Dim strName As String

Set wsData = ActiveWorkbook.Worksheets("Job Cost Summary")

Application.StatusBar = "Creating Workbooks. Please wait..."
Application.ScreenUpdating = False

'Count the number of rows
lngNumRows = wsData.Range("F65536").End(xlUp).Row

'Create a collection of managers
On Error Resume Next
For Each cell In wsData.Range("E6:E" & lngNumRows)
If cell.Value = "" Then cell.Value = "Unknown"
colManagers.Add cell.Value, CStr(cell.Value)
Next cell
On Error GoTo 0

'Filter on each manager and print
For Each vntManager In colManagers

Set wkbk = Application.Workbooks.Add

'Plug in each manager's name into the filter criteria range
wsData.Range("F2").Value = vntManager

'Add a new worksheet
wkbk.Sheets.Add befo=wkbk.Worksheets("Sheet1")
Set ws = ActiveSheet
ws.Name = vntManager

'Copy the field names from the original worksheet
wsData.Range("1:3").Copy ws.Range("1:3")

'Filter the data and copy to the new workbook
wsData.Range("A5").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, criteriarange:=wsData.Range("F1:F2"), _
copytorange:=ws.Range("A5")

'By default my new workbooks are created with 3 sheets
'This step deletes these sheets
If wkbk.Sheets.Count 3 Then
Application.DisplayAlerts = False
wkbk.Worksheets("Sheet1").Delete
wkbk.Worksheets("Sheet2").Delete
wkbk.Worksheets("Sheet3").Delete
Application.DisplayAlerts = True
End If

'Create a name for the workbook and save it
strName = "C:\Docs\Job Cost Summary " & vntManager
wkbk.SaveAs (strName)
wkbk.Close (False)

Next vntManager

'Clear my Filter Range
wsData.Range("F1:F2").Clear

LeaveSub:

Set colManagers = Nothing
Set cell = Nothing
Set wsData = Nothing
Set ws = Nothing

Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

In ,
hef typed:
I have one file with information on 833 suppliers.

I have to send to each supplier a list of only their parts, have them
fill in one column and then send me their file back. I could send
them a hard copy...but then it would take me forever to compile the
data when the information's returned.

We figured it would be easier to send each supplier their own
spreadsheet. And then remerge the data when it is sent back. Hence
the reason I need 833 different sheets...

I know...what a pain. Although, at least I realized there had to be a
quicker way then doing it maual (talk about a nightmare). ugh...

Thanks for any help in advance!!!

Hillary


------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~View and post usenet messages directly from
http://www.ExcelForum.com/

Volker,

What my code does is to look at a worksheet called "Job Cost Summary".
Each row on this worksheet has information about a projects and column F
contains the name of the manager of that project. I need to send each
project manager information about their own projects. So...

First I build a collection from the contents of column F that contains
each manager's name once. Then I loop through the collection, and put
the value of each item in the collection into a filter criteria range.
Then I do the filter and copy the results into a new workbook. Once
that's created I get the next item in the collection and do a filter on
that value, then copy the results to a new workbook, and so on.

Where are you running into problems? What is the structure of your data?
What are you trying to do? If you post the code you're using and let me
know where it's falling over, I'll try to help.

--
HTH,
Dianne

In ,
Volker Hormuth typed:
Hi Dianne,

please show me the structure of your datatable or send a workbook to
me. I got a mistake.
Thanks !

Volker

"Dianne" schrieb im Newsbeitrag
...
Here's a really chopped up version of a macro I use to send data to
each of our managers. Be warned that you'll have to do some
modification. You could also modify the section where I save to
email it instead.

Sub CreatePMWorkbooks()

Dim wkbk As Workbook
Dim cell As Range
Dim colManagers As New Collection
Dim wsData As Worksheet
Dim ws As Worksheet
Dim vntManager As Variant
Dim lngNumRows As Long
Dim strName As String

Set wsData = ActiveWorkbook.Worksheets("Job Cost Summary")

Application.StatusBar = "Creating Workbooks. Please wait..."
Application.ScreenUpdating = False

'Count the number of rows
lngNumRows = wsData.Range("F65536").End(xlUp).Row

'Create a collection of managers
On Error Resume Next
For Each cell In wsData.Range("E6:E" & lngNumRows)
If cell.Value = "" Then cell.Value = "Unknown"
colManagers.Add cell.Value, CStr(cell.Value)
Next cell
On Error GoTo 0

'Filter on each manager and print
For Each vntManager In colManagers

Set wkbk = Application.Workbooks.Add

'Plug in each manager's name into the filter criteria range
wsData.Range("F2").Value = vntManager

'Add a new worksheet
wkbk.Sheets.Add befo=wkbk.Worksheets("Sheet1")
Set ws = ActiveSheet
ws.Name = vntManager

'Copy the field names from the original worksheet
wsData.Range("1:3").Copy ws.Range("1:3")

'Filter the data and copy to the new workbook
wsData.Range("A5").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, criteriarange:=wsData.Range("F1:F2"), _
copytorange:=ws.Range("A5")

'By default my new workbooks are created with 3 sheets
'This step deletes these sheets
If wkbk.Sheets.Count 3 Then
Application.DisplayAlerts = False
wkbk.Worksheets("Sheet1").Delete
wkbk.Worksheets("Sheet2").Delete
wkbk.Worksheets("Sheet3").Delete
Application.DisplayAlerts = True
End If

'Create a name for the workbook and save it
strName = "C:\Docs\Job Cost Summary " & vntManager
wkbk.SaveAs (strName)
wkbk.Close (False)

Next vntManager

'Clear my Filter Range
wsData.Range("F1:F2").Clear

LeaveSub:

Set colManagers = Nothing
Set cell = Nothing
Set wsData = Nothing
Set ws = Nothing

Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

In ,
hef typed:
I have one file with information on 833 suppliers.

I have to send to each supplier a list of only their parts, have
them fill in one column and then send me their file back. I could
send them a hard copy...but then it would take me forever to
compile the data when the information's returned.

We figured it would be easier to send each supplier their own
spreadsheet. And then remerge the data when it is sent back. Hence
the reason I need 833 different sheets...

I know...what a pain. Although, at least I realized there had to
be a quicker way then doing it maual (talk about a nightmare).
ugh...

Thanks for any help in advance!!!

Hillary


------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~View and post usenet messages directly from
http://www.ExcelForum.com/

Hi Dianne,

the code is now running without an error, but I don`t get the result I want.
Here is the structure of my dates. I suppose I wasn`t able to suit the code
for my data-structure.

Sheet "JobCostSummary"
A B C D
1 Header1 Header2 Header3 Header4
2 Manager1 Mark1-1 Mark1-2 Mark1-3
3 Manager2 Mark2-1 Mark2-2 Mark2-3
4 Manager3 Mark3-1 Mark3-2 Mark3-3
5 Manager1 Mark4-1 Mark4-2 Mark4-3

New Sheet "Manager1"
1 Header1 Header2 Header3 Header4
2 Manager1 Mark1-1 Mark1-2 Mark1-3
3 Manager1 Mark4-1 Mark4-2 Mark4-3

New Sheet "Manager2"
1 Header1 Header2 Header3 Header4
2 Manager2 Mark2-1 Mark2-2 Mark2-3

New Sheet "Manager3"
1 Header1 Header2 Header3 Header4
2 Manager3 Mark3-1 Mark3-2 Mark3-3

AdvancedFilter F1 and F2.

Perhaps you can show me where I have to change the code.

Thanks
Volker



"Dianne" schrieb im Newsbeitrag
...
Volker,

What my code does is to look at a worksheet called "Job Cost Summary".
Each row on this worksheet has information about a projects and column F
contains the name of the manager of that project. I need to send each
project manager information about their own projects. So...

First I build a collection from the contents of column F that contains
each manager's name once. Then I loop through the collection, and put
the value of each item in the collection into a filter criteria range.
Then I do the filter and copy the results into a new workbook. Once
that's created I get the next item in the collection and do a filter on
that value, then copy the results to a new workbook, and so on.

Where are you running into problems? What is the structure of your data?
What are you trying to do? If you post the code you're using and let me
know where it's falling over, I'll try to help.

--
HTH,
Dianne

In ,
Volker Hormuth typed:
Hi Dianne,

please show me the structure of your datatable or send a workbook to
me. I got a mistake.
Thanks !

Volker

"Dianne" schrieb im Newsbeitrag
...
Here's a really chopped up version of a macro I use to send data to
each of our managers. Be warned that you'll have to do some
modification. You could also modify the section where I save to
email it instead.

Sub CreatePMWorkbooks()

Dim wkbk As Workbook
Dim cell As Range
Dim colManagers As New Collection
Dim wsData As Worksheet
Dim ws As Worksheet
Dim vntManager As Variant
Dim lngNumRows As Long
Dim strName As String

Set wsData = ActiveWorkbook.Worksheets("Job Cost Summary")

Application.StatusBar = "Creating Workbooks. Please wait..."
Application.ScreenUpdating = False

'Count the number of rows
lngNumRows = wsData.Range("F65536").End(xlUp).Row

'Create a collection of managers
On Error Resume Next
For Each cell In wsData.Range("E6:E" & lngNumRows)
If cell.Value = "" Then cell.Value = "Unknown"
colManagers.Add cell.Value, CStr(cell.Value)
Next cell
On Error GoTo 0

'Filter on each manager and print
For Each vntManager In colManagers

Set wkbk = Application.Workbooks.Add

'Plug in each manager's name into the filter criteria range
wsData.Range("F2").Value = vntManager

'Add a new worksheet
wkbk.Sheets.Add befo=wkbk.Worksheets("Sheet1")
Set ws = ActiveSheet
ws.Name = vntManager

'Copy the field names from the original worksheet
wsData.Range("1:3").Copy ws.Range("1:3")

'Filter the data and copy to the new workbook
wsData.Range("A5").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, criteriarange:=wsData.Range("F1:F2"), _
copytorange:=ws.Range("A5")

'By default my new workbooks are created with 3 sheets
'This step deletes these sheets
If wkbk.Sheets.Count 3 Then
Application.DisplayAlerts = False
wkbk.Worksheets("Sheet1").Delete
wkbk.Worksheets("Sheet2").Delete
wkbk.Worksheets("Sheet3").Delete
Application.DisplayAlerts = True
End If

'Create a name for the workbook and save it
strName = "C:\Docs\Job Cost Summary " & vntManager
wkbk.SaveAs (strName)
wkbk.Close (False)

Next vntManager

'Clear my Filter Range
wsData.Range("F1:F2").Clear

LeaveSub:

Set colManagers = Nothing
Set cell = Nothing
Set wsData = Nothing
Set ws = Nothing

Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

In ,
hef typed:
I have one file with information on 833 suppliers.

I have to send to each supplier a list of only their parts, have
them fill in one column and then send me their file back. I could
send them a hard copy...but then it would take me forever to
compile the data when the information's returned.

We figured it would be easier to send each supplier their own
spreadsheet. And then remerge the data when it is sent back. Hence
the reason I need 833 different sheets...

I know...what a pain. Although, at least I realized there had to
be a quicker way then doing it maual (talk about a nightmare).
ugh...

Thanks for any help in advance!!!

Hillary


------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~View and post usenet messages directly from
http://www.ExcelForum.com/

Volker,

I have emailed you a workbook. This workbook has two sheets -- MyData
which has the data in your format below (I have changed the headers),
and MyFilter, which has two relevant cells -- A1 has "Header1" and A2 is
where you will put each Manager's (or Customer's) name to do the
filtering.

The code doesn't do any error trapping, for example it doesn't test for
whether you already have a folder called c:\MyFiles -- you'll have to
change the code to point to an appropriate folder.

Here's the code from the workbook

Sub CreateWorkbooks()

Dim wkbkCurrent As Workbook
Dim wkbkNew As Workbook
Dim wsData As Worksheet
Dim wsFilter As Worksheet
Dim ws As Worksheet
Dim cell As Range
Dim colManagers As New Collection
Dim vntManager As Variant
Dim lngNumRows As Long
Dim strName As String

Set wkbkCurrent = ActiveWorkbook
Set wsData = wkbkCurrent.Worksheets("MyData")
Set wsFilter = wkbkCurrent.Worksheets("MyFilter")

Application.StatusBar = "Creating workbooks. Please wait..."
Application.ScreenUpdating = False

'Count the number of rows
lngNumRows = wsData.Range("A" & Rows.Count).End(xlUp).Row

'Create a collection of managers from values in column A
On Error Resume Next
For Each cell In wsData.Range("A2:A" & lngNumRows)
colManagers.Add cell.Value, CStr(cell.Value)
Next cell
On Error GoTo 0

'Filter on each manager, create workbook,
'save workbook and close workbook
For Each vntManager In colManagers

Set wkbkNew = Application.Workbooks.Add

'Put the manager's name into the filter criteria range
wkbkCurrent.Worksheets("MyFilter").Range("A2").Val ue =
vntManager

'Create a new worksheet in the new workbook
wkbkNew.Sheets.Add befo=wkbkNew.Worksheets("Sheet1")

Set ws = ActiveSheet

'Change the sheet name
ws.Name = vntManager

'Filter the data based on your criteria range
'and copy the filtered data to the new workbook
wsData.Range("A1").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=wsFilter.Range("A1:A2"), _
CopyToRange:=ws.Range("A1")

'Create a file name, save and close
strName = "C:\MyFiles\" & "MyData " & vntManager
wkbkNew.SaveAs (strName)
wkbkNew.Close (False)

Next vntManager

LeaveSub:

Set colManagers = Nothing
Set cell = Nothing
Set wsData = Nothing
Set ws = Nothing
Set wsFilter = Nothing
Set wkbkNew = Nothing
Set wkbkCurrent = Nothing

Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

Let me know if you have any questions.

--
HTH,
Dianne

In ,
Volker Hormuth typed:
Hi Dianne,

the code is now running without an error, but I don`t get the result
I want. Here is the structure of my dates. I suppose I wasn`t able to
suit the code for my data-structure.

Sheet "JobCostSummary"
A B C D
1 Header1 Header2 Header3 Header4
2 Manager1 Mark1-1 Mark1-2 Mark1-3
3 Manager2 Mark2-1 Mark2-2 Mark2-3
4 Manager3 Mark3-1 Mark3-2 Mark3-3
5 Manager1 Mark4-1 Mark4-2 Mark4-3

New Sheet "Manager1"
1 Header1 Header2 Header3 Header4
2 Manager1 Mark1-1 Mark1-2 Mark1-3
3 Manager1 Mark4-1 Mark4-2 Mark4-3

New Sheet "Manager2"
1 Header1 Header2 Header3 Header4
2 Manager2 Mark2-1 Mark2-2 Mark2-3

New Sheet "Manager3"
1 Header1 Header2 Header3 Header4
2 Manager3 Mark3-1 Mark3-2 Mark3-3

AdvancedFilter F1 and F2.

Perhaps you can show me where I have to change the code.

Thanks
Volker



"Dianne" schrieb im Newsbeitrag
...
Volker,

What my code does is to look at a worksheet called "Job Cost
Summary". Each row on this worksheet has information about a
projects and column F contains the name of the manager of that
project. I need to send each project manager information about their
own projects. So...

First I build a collection from the contents of column F that
contains each manager's name once. Then I loop through the
collection, and put the value of each item in the collection into a
filter criteria range. Then I do the filter and copy the results
into a new workbook. Once that's created I get the next item in the
collection and do a filter on that value, then copy the results to a
new workbook, and so on.

Where are you running into problems? What is the structure of your
data? What are you trying to do? If you post the code you're using
and let me know where it's falling over, I'll try to help.

--
HTH,
Dianne

In ,
Volker Hormuth typed:
Hi Dianne,

please show me the structure of your datatable or send a workbook to
me. I got a mistake.
Thanks !

Volker

"Dianne" schrieb im Newsbeitrag
...
Here's a really chopped up version of a macro I use to send data to
each of our managers. Be warned that you'll have to do some
modification. You could also modify the section where I save to
email it instead.

Sub CreatePMWorkbooks()

Dim wkbk As Workbook
Dim cell As Range
Dim colManagers As New Collection
Dim wsData As Worksheet
Dim ws As Worksheet
Dim vntManager As Variant
Dim lngNumRows As Long
Dim strName As String

Set wsData = ActiveWorkbook.Worksheets("Job Cost Summary")

Application.StatusBar = "Creating Workbooks. Please wait..."
Application.ScreenUpdating = False

'Count the number of rows
lngNumRows = wsData.Range("F65536").End(xlUp).Row

'Create a collection of managers
On Error Resume Next
For Each cell In wsData.Range("E6:E" & lngNumRows)
If cell.Value = "" Then cell.Value = "Unknown"
colManagers.Add cell.Value, CStr(cell.Value)
Next cell
On Error GoTo 0

'Filter on each manager and print
For Each vntManager In colManagers

Set wkbk = Application.Workbooks.Add

'Plug in each manager's name into the filter criteria range
wsData.Range("F2").Value = vntManager

'Add a new worksheet
wkbk.Sheets.Add befo=wkbk.Worksheets("Sheet1")
Set ws = ActiveSheet
ws.Name = vntManager

'Copy the field names from the original worksheet
wsData.Range("1:3").Copy ws.Range("1:3")

'Filter the data and copy to the new workbook
wsData.Range("A5").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, criteriarange:=wsData.Range("F1:F2"), _
copytorange:=ws.Range("A5")

'By default my new workbooks are created with 3 sheets
'This step deletes these sheets
If wkbk.Sheets.Count 3 Then
Application.DisplayAlerts = False
wkbk.Worksheets("Sheet1").Delete
wkbk.Worksheets("Sheet2").Delete
wkbk.Worksheets("Sheet3").Delete
Application.DisplayAlerts = True
End If

'Create a name for the workbook and save it
strName = "C:\Docs\Job Cost Summary " & vntManager
wkbk.SaveAs (strName)
wkbk.Close (False)

Next vntManager

'Clear my Filter Range
wsData.Range("F1:F2").Clear

LeaveSub:

Set colManagers = Nothing
Set cell = Nothing
Set wsData = Nothing
Set ws = Nothing

Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

In ,
hef typed:
I have one file with information on 833 suppliers.

I have to send to each supplier a list of only their parts, have
them fill in one column and then send me their file back. I could
send them a hard copy...but then it would take me forever to
compile the data when the information's returned.

We figured it would be easier to send each supplier their own
spreadsheet. And then remerge the data when it is sent back.
Hence the reason I need 833 different sheets...

I know...what a pain. Although, at least I realized there had to
be a quicker way then doing it maual (talk about a nightmare).
ugh...

Thanks for any help in advance!!!

Hillary


------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~View and post usenet messages directly from
http://www.ExcelForum.com/

Hi Dianne,

thanks for the workbook. The code is ok.
I now can do what I wanted.

Volker


"Dianne" schrieb im Newsbeitrag
...
Volker,

I have emailed you a workbook. This workbook has two sheets -- MyData
which has the data in your format below (I have changed the headers),
and MyFilter, which has two relevant cells -- A1 has "Header1" and A2 is
where you will put each Manager's (or Customer's) name to do the
filtering.

The code doesn't do any error trapping, for example it doesn't test for
whether you already have a folder called c:\MyFiles -- you'll have to
change the code to point to an appropriate folder.

Here's the code from the workbook

Sub CreateWorkbooks()

Dim wkbkCurrent As Workbook
Dim wkbkNew As Workbook
Dim wsData As Worksheet
Dim wsFilter As Worksheet
Dim ws As Worksheet
Dim cell As Range
Dim colManagers As New Collection
Dim vntManager As Variant
Dim lngNumRows As Long
Dim strName As String

Set wkbkCurrent = ActiveWorkbook
Set wsData = wkbkCurrent.Worksheets("MyData")
Set wsFilter = wkbkCurrent.Worksheets("MyFilter")

Application.StatusBar = "Creating workbooks. Please wait..."
Application.ScreenUpdating = False

'Count the number of rows
lngNumRows = wsData.Range("A" & Rows.Count).End(xlUp).Row

'Create a collection of managers from values in column A
On Error Resume Next
For Each cell In wsData.Range("A2:A" & lngNumRows)
colManagers.Add cell.Value, CStr(cell.Value)
Next cell
On Error GoTo 0

'Filter on each manager, create workbook,
'save workbook and close workbook
For Each vntManager In colManagers

Set wkbkNew = Application.Workbooks.Add

'Put the manager's name into the filter criteria range
wkbkCurrent.Worksheets("MyFilter").Range("A2").Val ue =
vntManager

'Create a new worksheet in the new workbook
wkbkNew.Sheets.Add befo=wkbkNew.Worksheets("Sheet1")

Set ws = ActiveSheet

'Change the sheet name
ws.Name = vntManager

'Filter the data based on your criteria range
'and copy the filtered data to the new workbook
wsData.Range("A1").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=wsFilter.Range("A1:A2"), _
CopyToRange:=ws.Range("A1")

'Create a file name, save and close
strName = "C:\MyFiles\" & "MyData " & vntManager
wkbkNew.SaveAs (strName)
wkbkNew.Close (False)

Next vntManager

LeaveSub:

Set colManagers = Nothing
Set cell = Nothing
Set wsData = Nothing
Set ws = Nothing
Set wsFilter = Nothing
Set wkbkNew = Nothing
Set wkbkCurrent = Nothing

Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

Let me know if you have any questions.

--
HTH,
Dianne

In ,
Volker Hormuth typed:
Hi Dianne,

the code is now running without an error, but I don`t get the result
I want. Here is the structure of my dates. I suppose I wasn`t able to
suit the code for my data-structure.

Sheet "JobCostSummary"
A B C D
1 Header1 Header2 Header3 Header4
2 Manager1 Mark1-1 Mark1-2 Mark1-3
3 Manager2 Mark2-1 Mark2-2 Mark2-3
4 Manager3 Mark3-1 Mark3-2 Mark3-3
5 Manager1 Mark4-1 Mark4-2 Mark4-3

New Sheet "Manager1"
1 Header1 Header2 Header3 Header4
2 Manager1 Mark1-1 Mark1-2 Mark1-3
3 Manager1 Mark4-1 Mark4-2 Mark4-3

New Sheet "Manager2"
1 Header1 Header2 Header3 Header4
2 Manager2 Mark2-1 Mark2-2 Mark2-3

New Sheet "Manager3"
1 Header1 Header2 Header3 Header4
2 Manager3 Mark3-1 Mark3-2 Mark3-3

AdvancedFilter F1 and F2.

Perhaps you can show me where I have to change the code.

Thanks
Volker



"Dianne" schrieb im Newsbeitrag
...
Volker,

What my code does is to look at a worksheet called "Job Cost
Summary". Each row on this worksheet has information about a
projects and column F contains the name of the manager of that
project. I need to send each project manager information about their
own projects. So...

First I build a collection from the contents of column F that
contains each manager's name once. Then I loop through the
collection, and put the value of each item in the collection into a
filter criteria range. Then I do the filter and copy the results
into a new workbook. Once that's created I get the next item in the
collection and do a filter on that value, then copy the results to a
new workbook, and so on.

Where are you running into problems? What is the structure of your
data? What are you trying to do? If you post the code you're using
and let me know where it's falling over, I'll try to help.

--
HTH,
Dianne

In ,
Volker Hormuth typed:
Hi Dianne,

please show me the structure of your datatable or send a workbook to
me. I got a mistake.
Thanks !

Volker

"Dianne" schrieb im Newsbeitrag
...
Here's a really chopped up version of a macro I use to send data to
each of our managers. Be warned that you'll have to do some
modification. You could also modify the section where I save to
email it instead.

Sub CreatePMWorkbooks()

Dim wkbk As Workbook
Dim cell As Range
Dim colManagers As New Collection
Dim wsData As Worksheet
Dim ws As Worksheet
Dim vntManager As Variant
Dim lngNumRows As Long
Dim strName As String

Set wsData = ActiveWorkbook.Worksheets("Job Cost Summary")

Application.StatusBar = "Creating Workbooks. Please wait..."
Application.ScreenUpdating = False

'Count the number of rows
lngNumRows = wsData.Range("F65536").End(xlUp).Row

'Create a collection of managers
On Error Resume Next
For Each cell In wsData.Range("E6:E" & lngNumRows)
If cell.Value = "" Then cell.Value = "Unknown"
colManagers.Add cell.Value, CStr(cell.Value)
Next cell
On Error GoTo 0

'Filter on each manager and print
For Each vntManager In colManagers

Set wkbk = Application.Workbooks.Add

'Plug in each manager's name into the filter criteria range
wsData.Range("F2").Value = vntManager

'Add a new worksheet
wkbk.Sheets.Add befo=wkbk.Worksheets("Sheet1")
Set ws = ActiveSheet
ws.Name = vntManager

'Copy the field names from the original worksheet
wsData.Range("1:3").Copy ws.Range("1:3")

'Filter the data and copy to the new workbook
wsData.Range("A5").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, criteriarange:=wsData.Range("F1:F2"), _
copytorange:=ws.Range("A5")

'By default my new workbooks are created with 3 sheets
'This step deletes these sheets
If wkbk.Sheets.Count 3 Then
Application.DisplayAlerts = False
wkbk.Worksheets("Sheet1").Delete
wkbk.Worksheets("Sheet2").Delete
wkbk.Worksheets("Sheet3").Delete
Application.DisplayAlerts = True
End If

'Create a name for the workbook and save it
strName = "C:\Docs\Job Cost Summary " & vntManager
wkbk.SaveAs (strName)
wkbk.Close (False)

Next vntManager

'Clear my Filter Range
wsData.Range("F1:F2").Clear

LeaveSub:

Set colManagers = Nothing
Set cell = Nothing
Set wsData = Nothing
Set ws = Nothing

Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

In ,
hef typed:
I have one file with information on 833 suppliers.

I have to send to each supplier a list of only their parts, have
them fill in one column and then send me their file back. I could
send them a hard copy...but then it would take me forever to
compile the data when the information's returned.

We figured it would be easier to send each supplier their own
spreadsheet. And then remerge the data when it is sent back.
Hence the reason I need 833 different sheets...

I know...what a pain. Although, at least I realized there had to
be a quicker way then doing it maual (talk about a nightmare).
ugh...

Thanks for any help in advance!!!

Hillary


------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~View and post usenet messages directly from
http://www.ExcelForum.com/

I want to do the exact same thing, as you can see in my post next t
this one. This code, however, returns a "subscript out of range
error.

Any pointers

--
Message posted from http://www.ExcelForum.com