Combine multisheet into 1 database using macro

[Choong]

I have a workbook consists of multiple sheet with date as sheet name. And the max data per sheet is 17 record and if exceed then it will have another sheet with the same data and continue the numbering. The sheet will be daily add in until end of the month. Hope to have a macro to combine the data into 1 sheet daily.(daily up to date)

 

[chirayu]

I've added an extra column in "Results" sheet which will have the sheet name the data was copied from

Sub Copier()

Dim ws As Worksheet
Dim shname As String

For Each ws In ActiveWorkbook.Worksheets

    If ws.Name <> "results" Then
        ws.Select
        shname = ws.Name
        Range("C3:L" & Cells(Rows.Count, "D").End(xlUp).Row).Copy
        Worksheets("Results").Select
        Range("A" & Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row).Select
        ActiveSheet.Paste
        Range("K" & Cells(Rows.Count, "K").End(xlUp).Offset(1, 0).Row).Select
        Do Until IsEmpty(Range("A" & ActiveCell.Row))
            ActiveCell.Value = shname
            ActiveCell.Offset(1, 0).Select
        Loop
        Worksheets(shname).Select
    Else
    End If
Next ws

End Sub