Macro to insert new sheets and copy information.
 

Hi

I receive a huge xls file on a monthly basis. Column A is used for ID
nr only, and is always sorted.

Question: is it possible to make a macro that instert a new sheet for
each change in ID nr, and that also copy all rows with identical ID nr
to the new sheet?

Example:
Workbookname Transactions.xls
Sheet used: Januar
"Picture" of the sheet named Januar
ROW NR COLUMN A COLUMN B
1 ID NR Text
2 1 a
3 1 b
4 1 c
5 2 d
6 2 e
7 3 f
8 3 g
9 3 h


The macro should insert three new sheets named 1, 2 and 3.

"Picture" of the sheet named 1
ROW R COLUMN A COLUMN B
1 1 a
2 1 b
3 1 c


"Picture" of the sheet named 2
ROW R COLUMN A COLUMN B
1 2 d
2 2 e

"Picture" of the sheet named 3
ROW R COLUMN A COLUMN B
1 3 f
2 3 g
3 3 h

Regards,
Paul

Macro to insert new sheets and copy information.
 

Paul,

This wil do it:

Sub SplitData()
Const ID_Column As Integer = 1
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lRow As Long, lLen As Long
Dim strID As String

Application.ScreenUpdating = False

Set wsSource = ActiveSheet
lRow = 2

Do
lLen = 1

strID = wsSource.Cells(lRow, ID_Column).Formula
Do While wsSource.Cells(lRow + lLen,
ID_Column).Formula = strID _
And wsSource.Cells(lRow + lLen, ID_Column).Formula
< ""
lLen = lLen + 1
Loop

Set wsTarget = Worksheets.Add
wsTarget.Name = strID
wsSource.Rows(lRow & ":" & lRow + lLen - 1).Copy _
Destination:=wsTarget.Range("A1")

lRow = lRow + lLen
Loop While wsSource.Cells(lRow, ID_Column).Formula < ""

Application.ScreenUpdating = True
End Sub

Have the data sheet active, then run the macro.

Cheers,
Dave.
-----Original Message-----
Hi

I receive a huge xls file on a monthly basis. Column A is
used for ID
nr only, and is always sorted.

Question: is it possible to make a macro that instert a
new sheet for
each change in ID nr, and that also copy all rows with
identical ID nr
to the new sheet?

Example:
Workbookname Transactions.xls
Sheet used: Januar
"Picture" of the sheet named Januar
ROW NR COLUMN A COLUMN B
1 ID NR Text
2 1 a
3 1 b
4 1 c
5 2 d
6 2 e
7 3 f
8 3 g
9 3 h


The macro should insert three new sheets named 1, 2 and 3.

"Picture" of the sheet named 1
ROW R COLUMN A COLUMN B
1 1 a
2 1 b
3 1 c


"Picture" of the sheet named 2
ROW R COLUMN A COLUMN B
1 2 d
2 2 e

"Picture" of the sheet named 3
ROW R COLUMN A COLUMN B
1 3 f
2 3 g
3 3 h

Regards,
Paul
.

Macro to insert new sheets and copy information.
 

WOW :)

you saved a lot of work; I'm impressed!

Is it aslo possible to make another macro that also create new xls
files for each change in the ID number?

Thx in advance.

Regards,
Paul


"Dave Ramage" wrote in message ...
Paul,

This wil do it:

Sub SplitData()
Const ID_Column As Integer = 1
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lRow As Long, lLen As Long
Dim strID As String

Application.ScreenUpdating = False

Set wsSource = ActiveSheet
lRow = 2

Do
lLen = 1

strID = wsSource.Cells(lRow, ID_Column).Formula
Do While wsSource.Cells(lRow + lLen,
ID_Column).Formula = strID _
And wsSource.Cells(lRow + lLen, ID_Column).Formula
< ""
lLen = lLen + 1
Loop

Set wsTarget = Worksheets.Add
wsTarget.Name = strID
wsSource.Rows(lRow & ":" & lRow + lLen - 1).Copy _
Destination:=wsTarget.Range("A1")

lRow = lRow + lLen
Loop While wsSource.Cells(lRow, ID_Column).Formula < ""

Application.ScreenUpdating = True
End Sub

Have the data sheet active, then run the macro.

Cheers,
Dave.
-----Original Message-----
Hi

I receive a huge xls file on a monthly basis. Column A is
used for ID
nr only, and is always sorted.

Question: is it possible to make a macro that instert a
new sheet for
each change in ID nr, and that also copy all rows with
identical ID nr
to the new sheet?

Example:
Workbookname Transactions.xls
Sheet used: Januar
"Picture" of the sheet named Januar
ROW NR COLUMN A COLUMN B
1 ID NR Text
2 1 a
3 1 b
4 1 c
5 2 d
6 2 e
7 3 f
8 3 g
9 3 h


The macro should insert three new sheets named 1, 2 and 3.

"Picture" of the sheet named 1
ROW R COLUMN A COLUMN B
1 1 a
2 1 b
3 1 c


"Picture" of the sheet named 2
ROW R COLUMN A COLUMN B
1 2 d
2 2 e

"Picture" of the sheet named 3
ROW R COLUMN A COLUMN B
1 3 f
2 3 g
3 3 h

Regards,
Paul
.

Macro to insert new sheets and copy information.
 

With a slight mod, yes...

Sub SplitData_ToFiles()
'ID colum to define split. Must be grouped by this column
Const ID_Column As Integer = 1
'Folder in which to save files (must end in \)
Const BaseFolder As String = "C:\SYS\"
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lRow As Long, lLen As Long
Dim strID As String

Application.ScreenUpdating = False

Set wsSource = ActiveSheet
lRow = 2

Do
lLen = 1

strID = wsSource.Cells(lRow, ID_Column).Formula
Do While wsSource.Cells(lRow + lLen,
ID_Column).Formula = strID _
And wsSource.Cells(lRow + lLen, ID_Column).Formula
< ""
lLen = lLen + 1
Loop

'create new workbook
Set wsTarget = Workbooks.Add.Sheets(1)
wsTarget.Name = strID
wsSource.Rows(lRow & ":" & lRow + lLen - 1).Copy _
Destination:=wsTarget.Range("A1")
'save and close
wsTarget.Parent.SaveAs BaseFolder & strID & ".xls"
wsTarget.Parent.Close savechanges:=False

lRow = lRow + lLen
Loop While wsSource.Cells(lRow, ID_Column).Formula < ""

Application.ScreenUpdating = True
End Sub

If you want it is possible to make this 'flashier'- e.g.
prompt the user to choose a destination folder etc, or
have a status comment in the status bar..

Cheers,
Dave.

-----Original Message-----
WOW :)

you saved a lot of work; I'm impressed!

Is it aslo possible to make another macro that also
create new xls
files for each change in the ID number?

Thx in advance.

Regards,
Paul


"Dave Ramage" wrote in message
...
Paul,

This wil do it:

Sub SplitData()
Const ID_Column As Integer = 1
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lRow As Long, lLen As Long
Dim strID As String

Application.ScreenUpdating = False

Set wsSource = ActiveSheet
lRow = 2

Do
lLen = 1

strID = wsSource.Cells(lRow, ID_Column).Formula
Do While wsSource.Cells(lRow + lLen,
ID_Column).Formula = strID _
And wsSource.Cells(lRow + lLen,
ID_Column).Formula
< ""
lLen = lLen + 1
Loop

Set wsTarget = Worksheets.Add
wsTarget.Name = strID
wsSource.Rows(lRow & ":" & lRow + lLen - 1).Copy _
Destination:=wsTarget.Range("A1")

lRow = lRow + lLen
Loop While wsSource.Cells(lRow, ID_Column).Formula < ""

Application.ScreenUpdating = True
End Sub

Have the data sheet active, then run the macro.

Cheers,
Dave.
-----Original Message-----
Hi

I receive a huge xls file on a monthly basis. Column A
is
used for ID
nr only, and is always sorted.

Question: is it possible to make a macro that instert
a
new sheet for
each change in ID nr, and that also copy all rows with
identical ID nr
to the new sheet?

Example:
Workbookname Transactions.xls
Sheet used: Januar
"Picture" of the sheet named Januar
ROW NR COLUMN A COLUMN B
1 ID NR Text
2 1 a
3 1 b
4 1 c
5 2 d
6 2 e
7 3 f
8 3 g
9 3 h


The macro should insert three new sheets named 1, 2
and 3.

"Picture" of the sheet named 1
ROW R COLUMN A COLUMN B
1 1 a
2 1 b
3 1 c


"Picture" of the sheet named 2
ROW R COLUMN A COLUMN B
1 2 d
2 2 e

"Picture" of the sheet named 3
ROW R COLUMN A COLUMN B
1 3 f
2 3 g
3 3 h

Regards,
Paul
.

.

Macro to insert new sheets and copy information.
 

"Dave Ramage" wrote in message ...
With a slight mod, yes...

Sub SplitData_ToFiles()
'ID colum to define split. Must be sorted by this column
Const ID_Column As Integer = 9
'Folder in which to save files (must end in \)
Const BaseFolder As String = "C:\TEMP\"
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lRow As Long, lLen As Long
Dim strID As String

---- Lots of code & words snipped out.... ----

Dave - It's amazing that you posted this code on the same day I was
looking for exactly the same thing! I find that figuring things out
in VBA is much easier with examples like yours. Thanks. I have an
additional question. I would like there to be a cover sheet in the
new table. I can set one up manually in the source workbook but I
have not been able to copy it into the new workbook. Can you fit that
into your example? --

Thanks - dg