Sub CreateLoop()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim S1 As Worksheet
Set S1 = ThisWorkbook.Sheets("Sheet2") 'Change With ur Sheet Name
If S1.AutoFilterMode Then S1.AutoFilter.ShowAllData
Dim Nwb, Awb As Workbook
Dim Nsh As Worksheet
Set Awb = ActiveWorkbook
'To Make File Name, u can edit it
Range("F2").Formula = "=TEXTJOIN(""_"",,TEXT(B2,""MM""),TEXT(B2,""YYYY""))"
Range("F2").AutoFill Destination:=Range("F2:F" & Range("B" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
'Loop
Dim i, f As Integer
For i = 2 To Application.CountA(S1.Range("B:B"))
S1.Range("A1:D1").AutoFilter 2, S1.Range("B" & i).Value 'looping by filter
Set Nwb = Workbooks.Add
Set Nsh = Nwb.Sheets(1)
S1.Range("A1:D1" & Cells(Rows.Count, "A").End(xlUp).Row).Copy 'copy data
Nsh.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Nsh.UsedRange.EntireColumn.ColumnWidth = 15
Nwb.SaveAs S1.Range("F1").Value & S1.Range("F" & i).Value & ".xlsx"
Nwb.Close False
Next i
If S1.AutoFilterMode Then S1.AutoFilter.ShowAllData
S1.Range("F2:F" & Cells(Rows.Count, "B").End(xlUp).Row).ClearContents
MsgBox "Done"
End Sub