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