Need help with this VBA to create new tabs

[skell01]

This script creates a new tab for each day of the week for any month entered. I want to have the script create 3 tabs for each day of the month.

If possible I'd like the script to NOT add a tab if it is a Sunday.
I grabbed this script online, I am a novice.

Thanks in advance for any help.

Sub DoDays()
Dim J As Integer
Dim K As Integer
Dim sDay As String
Dim sTemp As String
Dim iTarget As Integer
Dim dBasis As Date

iTarget = 13
While (iTarget < 1) Or (iTarget > 12)
iTarget = Val(InputBox("Numeric month?"))
If iTarget = 0 Then Exit Sub
Wend

Application.ScreenUpdating = False
sTemp = Str(iTarget) & "/1/" & Year(Now())
dBasis = CDate(sTemp)

For J = 1 To 31
sDay = Format((dBasis + J - 1), "dddd mm-dd-yyyy")
If Month(dBasis + J - 1) = iTarget Then

If J <= Sheets.Count Then
If Left(Sheets(J).Name, 5) = "Sheet" Then
Sheets(J).Name = sDay
Else
Sheets.Add.Move after:=Sheets(Sheets.Count)
ActiveSheet.Name = sDay
End If
Else
Sheets.Add.Move after:=Sheets(Sheets.Count)
ActiveSheet.Name = sDay
End If
End If
Next J

For J = 1 To (Sheets.Count - 1)
For K = J + 1 To Sheets.Count
If Right(Sheets(J).Name, 10) > _
Right(Sheets(K).Name, 10) Then
Sheets(K).Move Before:=Sheets(J)
End If
Next K
Next J

Sheets(1).Activate
Application.ScreenUpdating = True
End Sub

 

[ranman256]

Sub DoDays()
Dim J As Integer
Dim K As Integer
Dim sDay As String
Dim sTemp As String
Dim iTarget As Integer, i As Integer
Dim dBasis As Date
Dim vDow, vDate
iTarget = 13
While (iTarget < 1) Or (iTarget > 12)
    iTarget = Val(InputBox("Numeric month?"))
    If iTarget = 0 Then Exit Sub
Wend
Application.ScreenUpdating = False
sTemp = Str(iTarget) & "/1/" & Year(Now())
dBasis = CDate(sTemp)
For J = 1 To 31
    vDate = Str(iTarget) & "/" & J & "/" & Year(Now())
    If IsDate(vDate) Then
        sDay = Format(vDate, "dddd mm-dd-yyyy")
            vDow = Weekday(vDate)
            If vDow <> vbSunday Then GoSub Add3Sheets
    End If
Next J
For J = 1 To (Sheets.Count - 1)
    For K = J + 1 To Sheets.Count
        If Right(Sheets(J).Name, 10) > _
            Right(Sheets(K).Name, 10) Then
            Sheets(K).Move Before:=Sheets(J)
        End If
    Next K
Next J
Sheets(1).Activate
Application.ScreenUpdating = True
Exit Sub

Add3Sheets:
    For i = 1 To 3
      Sheets.Add.Move after:=Sheets(Sheets.Count)
      ActiveSheet.Name = sDay & "(" & i & ")"
    Next
Return
End Sub

 

[skell01]

Sub DoDays()
Dim J As Integer
Dim K As Integer
Dim sDay As String
Dim sTemp As String
Dim iTarget As Integer, i As Integer
Dim dBasis As Date
Dim vDow, vDate
iTarget = 13
While (iTarget < 1) Or (iTarget > 12)
    iTarget = Val(InputBox("Numeric month?"))
    If iTarget = 0 Then Exit Sub
Wend
Application.ScreenUpdating = False
sTemp = Str(iTarget) & "/1/" & Year(Now())
dBasis = CDate(sTemp)
For J = 1 To 31
    vDate = Str(iTarget) & "/" & J & "/" & Year(Now())
    If IsDate(vDate) Then
        sDay = Format(vDate, "dddd mm-dd-yyyy")
            vDow = Weekday(vDate)
            If vDow <> vbSunday Then GoSub Add3Sheets
    End If
Next J
For J = 1 To (Sheets.Count - 1)
    For K = J + 1 To Sheets.Count
        If Right(Sheets(J).Name, 10) > _
            Right(Sheets(K).Name, 10) Then
            Sheets(K).Move Before:=Sheets(J)
        End If
    Next K
Next J
Sheets(1).Activate
Application.ScreenUpdating = True
Exit Sub

Add3Sheets:
    For i = 1 To 3
      Sheets.Add.Move after:=Sheets(Sheets.Count)
      ActiveSheet.Name = sDay & "(" & i & ")"
    Next
Return
End Sub

Worked perfectly. Thank you.