Split Master Timesheet into Separate Sheets for Each Employee (employee list contained in a single cell within master timesheet)

Question

Hi,

I have a master timesheet which in one column has a list of employees - original data came from JotForm and the employees appear to be in the same cell but on separate rows within the same single cell

Full sheet extract here: https://www.dropbox.com/s/0d1uy1q70qt5g48/Hours%20Jun%2023_Summary_Gets%20Mins%20and%20Miles%20from%20Lookup%20Sheet_Power%20Query%20TEST%20extract.xlsx?dl=0

Every row in this sheet relates to a single job completed by that team. I need to split and be able to report the data individually for each employee.

I want to copy that single row (full row) into respective sheets for each employee and then the same for every row in that sheet

Such that the single employee summary appears in a single sheet/tab for that employee

I can then send each employee their individual timesheet for checking pre-payroll.

Please tell me the easiest way how I can achieve this?

Many Thanks

Kalpesh

Answer 1

This looks amazing

So if I want to separate the data for each individual i.e. so that I may send to them individually - how should I do that please?

Thanks Herbert Seidenberg

Much appreciated

Kalpesh

Answer 2

Afternoon AnastasiosGR

I really appreciate your help thank you so much

I have just run this on the full sheet and it seems to keep falling over at row 18.

I tried to delete a row and it still fails at row 18. So not sure if it's quite data specific?

Can you think of any specific reason this might be happening please?

Thanks

Kalpesh

Answer 3

Hi,

using vba code

source sheet Data

results

in 3 sheets Marina, Ola, Elena

===========================================

[Update-1]

Sub Split_Data()

' ## 28-06-2023 ##

Dim N

N = 3 ' headers in row 3

Const sNames$ = "S" 'names in column S

Dim nColl As New Collection

Dim wb As Workbook

Set wb = ThisWorkbook

Dim ws As Worksheet

Set ws = wb.Sheets("Data") '<< source sheet name

Dim rng As Range

Dim nRow, nCol, L2, v, x, cc

Application.ScreenUpdating = False

Application.DisplayAlerts = False

nRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

nCol = ws.Cells(N, Columns.Count).End(xlToLeft).Column

Sheets.Add

ActiveSheet.Name = "tmp"

ws.Rows(N).Copy

With Cells(1, 1)

.PasteSpecial xlPasteColumnWidths

.PasteSpecial xlPasteFormats, , False, False

.PasteSpecial xlPasteValues, , False, False

.Cells(1).Select

Application.CutCopyMode = False

End With

For Each r In ws.Range(ws.Cells(N + 1, sNames), ws.Cells(nRow, sNames))

L2 = Cells(Rows.Count, 1).End(xlUp).Row + 1

v = Split(r.Value, Chr(10))

ws.Rows(r.Row).Copy

With Cells(L2, 1).Resize(UBound(v) + 1)

.PasteSpecial xlPasteColumnWidths

.PasteSpecial xlFormats, , False, False

.PasteSpecial xlValues, , False, False

Cells(1).Select

Application.CutCopyMode = False

End With

For x = 0 To UBound(v)

Cells(L2 + x, sNames).Value = v(x)

Next x

Next r

Range("I:J").NumberFormat = "h:mm AM/PM"

Range("P:Q").NumberFormat = "0.0"

'///////////////////////////////////

N = 1

Set ws = Sheets("tmp")

nRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

nCol = ws.Cells(N, Columns.Count).End(xlToLeft).Column

On Error Resume Next

For Each r In ws.Range(ws.Cells(N + 1, sNames), ws.Cells(nRow, sNames))

nColl.Add r.Value, CStr(r.Value)

Next r

On Error GoTo 0

ws.Range(ws.Cells(N, sNames), ws.Cells(nRow, sNames)).AutoFilter

'delete old sheets

For Each cc In nColl

For Each sh In wb.Sheets

If sh.Name = cc Then sh.Delete

Next sh

Next cc

Set rng = Sheets("tmp").Range("A1").Resize(nRow, nCol)

For Each cc In nColl

Set newWS = wb.Sheets.Add(after:=wb.Sheets(wb.Sheets.Count))

newWS.Name = cc

rng.AutoFilter field:=1, Criteria1:=cc

rng.SpecialCells(xlCellTypeVisible).Copy

With newWS.Range("A1")

.PasteSpecial xlPasteColumnWidths

.PasteSpecial xlFormats, , False, False

.PasteSpecial xlValues, , False, False

Cells(1).Select

Application.CutCopyMode = False

End With

rng.AutoFilter field:=1

Next cc

ws.AutoFilterMode = False

ws.Select

Sheets("tmp").Delete

Set nColl = Nothing

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub

===============================

step1

Save  your Workbook with extension .xlsm (macros enabled workbook)

Step2

2a) press ALT+F11 to open Visual Basic

2b) from the ribbon, select: Insert > Module and paste the code above on the right 

2c) Press ALT+Q to Close Visual Basic

Step3

To run the macro, press ALT+F8, 

select 'Split_Data **'**from the list and click the run button.

or

add a button and assign the  vba macro

Answer 4

https://v.douyin.com/DC4NQQ7

split one sheet to separate workbook？

Answer 5

Excel 365 Pro Plus with Power Pivot and Power Query.

First steps.

Easy. Not.

https://www.mediafire.com/file_premium/skl71yhfwmyd2kw/06_26_23.xlsx/file

https://www.mediafire.com/file_premium/025dugiwalhsz8d/06_26_23.pdf/file