Creating Daily Sheet

The codes below is for creating sheets along with day of the sales.

 

------------------------------------------------------------------

Function Worksheet_Exists(name) As Boolean
    Worksheet_Exists = False
    For Each ws In ActiveWorkbook.Worksheets
        If ws.name = name Then Worksheet_Exists = True
    Next ws
End Function


Public Sub devide_file()
    Dim i As Long
    Dim Ln, Dn As Long
    Dim ws As Worksheet
    Dim Sname As String
    
    Set ws = Worksheets("総合")
    
    Ln = Cells(Rows.Count, "B").End(xlUp).Row
    
    For i = 3 To Ln
        ws.Activate
        Sname = WorksheetFunction.Text(Month(Cells(i, 2)), "00") & "月" & _
                WorksheetFunction.Text(Day(Cells(i, 2)), "00") & "日"
        If Not Worksheet_Exists(Sname) Then
            Worksheets.Add after:=Worksheets(Worksheets.Count)
            ActiveSheet.name = Sname
            ws.Cells(2, 1).EntireRow.Copy Cells(2, 1)
            Cells(2, 2).Value = 1                       'line number initialize on date cell
        End If
        
        Worksheets(Sname).Activate
        Dn = Cells(2, 2).Value                          'data number of the sheet of the day
        ws.Cells(i, 1).EntireRow.Copy Cells(Dn + 2, 1)
        Range("A:F").Columns.AutoFit
        Cells(2, 2).Value = Dn + 1
    Next i
    
    MsgBox "ファイル振分作業が終わりました", vbOKOnly
    
    
End Sub

daily sales.xlsm

0.02MB