Realign sheets as per the current months calendar

Sub Movesheets_Vijay_Anand()
' This is a self built logic designed by
' B.Vijay Anand -
' Please appreciate the logic design and the coding
' but do not try to take ownership of this prg and logic which you haven;t done
' you are free to use this program
'Sheets required to run this code
' Sheet1, 1,2,3,4,...31 and WTD1.... WTD6,MTD
On Error Resume Next
Set wb = ActiveWorkbook
Sheets("WTD1").Move after:=Sheets("31")
Sheets("WTD2").Move after:=Sheets("31")
Sheets("WTD3").Move after:=Sheets("31")
Sheets("WTD4").Move after:=Sheets("31")
Sheets("WTD5").Move after:=Sheets("31")
Sheets("WTD6").Move after:=Sheets("31")
Sheets("Sheet1").Select
Cells.Select
Selection.ClearContents
i = 1
Cells(1, 1).Resize(31, 1).ClearContents
Range("A1").Value = Month(Now) & "/01/" & Year(Now)
Range("A1").NumberFormat = "ddd dd/mm/yyyy"
Range("A1").AutoFill Destination:=Range("A1:A40"), Type:=xlFillDefault
For i1 = 40 To 1 Step -1
If Year(Cells(i1, 1).Value) > Year(Now) Then
Rows(i1).EntireRow.Delete
ElseIf Month(Cells(i1, 1).Value) > Month(Now) Then
Rows(i1).EntireRow.Delete
End If
Next i1
For i1 = 1 To 40 Step 1
If Weekday(Cells(i1, 1).Value, vbMonday) = 7 Then
Rows(i1 + 1).EntireRow.Insert
Cells(i1 + 1, 1).Value = "WTD" & i
i = i + 1
i1 = i1 + 1
End If
Next i1
Cells(1, 1).Select
Selection.End(xlDown).Select
Selection.End(xlDown + 1).Select
xy = ActiveCell.Row
Cells(xy + 1, 1).Value = "WTD" & i

For ii1 = 1 To 40 Step 1

If Sheets("Sheet1").Cells(ii1, 1).Value = "WTD1" Then
Sheets(ii1).Select
Sheets("WTD1").Move after:=ActiveSheet
ElseIf Sheets("Sheet1").Cells(ii1, 1).Value = "WTD2" Then
Sheets(ii1).Select
Sheets("WTD2").Move after:=ActiveSheet

ElseIf Sheets("Sheet1").Cells(ii1, 1).Value = "WTD3" Then
Sheets(ii1).Select
Sheets("WTD3").Move after:=ActiveSheet

ElseIf Sheets("Sheet1").Cells(ii1, 1).Value = "WTD4" Then
Sheets(ii1).Select
Sheets("WTD4").Move after:=ActiveSheet

ElseIf Sheets("Sheet1").Cells(ii1, 1).Value = "WTD5" Then
Sheets(ii1).Select
Sheets("WTD5").Move after:=ActiveSheet

ElseIf Sheets("Sheet1").Cells(ii1, 1).Value = "WTD6" Then
Sheets(ii1).Select
Sheets("WTD6").Move after:=ActiveSheet

End If
Next ii1
Sheets("Sheet1").Select

MsgBox (" Its done !! ")
End Sub