Option Explicit
Sub AASplit_in_A_Workbook()
Dim MySheet As Worksheet, ws As Worksheet
Dim MyRange As Range, i As Long, N As Workbook
Dim UList As Collection, UListValue As Variant, c As Long
Dim m As Range, cr As Range
Application.ScreenUpdating = False
c = 4 'Col D to filter
Set MySheet = ActiveSheet
If MySheet.AutoFilterMode = False Then Exit Sub
Set MyRange = Range(MySheet.AutoFilter.Range.Columns(c).Address)
Set UList = New Collection
On Error Resume Next
For i = 2 To MyRange.Rows.Count
UList.Add MyRange.Cells(i, 1), CStr(MyRange.Cells(i, 1))
Next i
On Error GoTo 0
For Each UListValue In UList
Set N = Workbooks.Add(xlWBATWorksheet)
For Each ws In ThisWorkbook.Sheets
Set m = ws.Columns(4).Find("Country")
Set cr = m.Offset(-1, 0).CurrentRegion
m.AutoFilter c, UListValue
With N
cr.SpecialCells(xlCellTypeVisible).Copy
Sheets.Add().Name = ws.Name
Sheets(ws.Name).Paste
Cells.EntireColumn.AutoFit
End With
ws.AutoFilterMode = False
Next ws
N.SaveAs Filename:=Application.ThisWorkbook.Path & "\" & UListValue.Value
N.Close False
Next UListValue
MySheet.Select
Set cr = Nothing
Set m = Nothing
Set MyRange = Nothing
Set MySheet = Nothing
Application.ScreenUpdating = True
End Sub