Button to split work and place it in separate sheets

[Shamas]

Hi, there are occasions when I am allocated some work. I would like to be able to paste that work into my spreadsheet from cell A4 onwards and then enter how many staff I have available in B2. A quick button press would then hopefully split the work by the number of staff by making individual sheets for me retaining the header row (row 4) on each new sheet created. Can you help please?

Excel Workbook
	A	B	C	D	E	F	G
1
2	Number of staff	3
3
4	Date	Time	Name	Code	Comments	Number
5	01/09/2011	19:00:00	Joe	A12121	Order booked	07777 111222
6	02/09/2011	20:00:00	Joe	A12122	Order booked	07778 111222
7	03/09/2011	21:00:00	Joe	A12123	Order booked	07778 111222
8	04/09/2011	22:00:00	Joe	A12124	Order booked	07778 111222
9	05/09/2011	23:00:00	Joe	A12125	Order booked	07778 111222
10	06/09/2011	00:00:00	Joe	A12126	Order booked	07778 111222
11	07/09/2011	01:00:00	Joe	A12127	Order booked	07778 111222
12	08/09/2011	02:00:00	Joe	A12128	Order booked	07778 111222
13	09/09/2011	03:00:00	Joe	A12129	Order booked	07778 111222
14	10/09/2011	04:00:00	Joe	A12130	Order booked	07778 111222
15	11/09/2011	05:00:00	Joe	A12131	Order booked	07778 111222
16
17
RAW DATA

 

[taurean]

Try this code on a backup. Even if it isn't what you need it should get you started anyway

Private Sub CommandButton1_Click()
Dim lLastRow As Long
Dim dRowToCopy As Integer
lLastRow = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
dRowToCopy = Application.Ceiling((lLastRow - 4) / Sheets(1).Range("B2").Value, 1)
For i = 2 To Range("B2").Value
If i > Sheets.Count Then Sheets.Add After:=Sheets(Sheets.Count)
Sheets(1).Range("A4").Resize(, 6).Copy _
Destination:=Sheets(i).Range("A" & Rows.Count).End(xlUp)(2)
Sheets(1).Range("A" & 5 + dRowToCopy).Resize(dRowToCopy, 6).Copy _
Destination:=Sheets(i).Range("A" & Rows.Count).End(xlUp)(2)
Sheets(1).Range("A" & 5 + dRowToCopy).Resize(dRowToCopy).EntireRow.Delete
Next i
End Sub

 

[Shamas]

Thanks this has worked for me!