جرب هذا الكود
 
Option Explicit
Sub Salim_Add_Sheets()
  
  Dim ERow01 As Long
  Dim arr_sheet(), my_name$
  Dim x%, y$, How_Many%, k%, i%
 
   ERow01 = Sheets("all").Range("a3").CurrentRegion.Rows.Count
    On Error Resume Next
  k = 1
    For i = 4 To ERow01
     How_Many = Application.CountIf(Sheets("all").Range("b4" & ":b" & i), Sheets("all").Range("b" & i))
If How_Many = 1 Then
 ReDim Preserve arr_sheet(1 To k)
 arr_sheet(k) = Sheets("all").Range("b" & i)
 k = k + 1
 End If
 Next
 For i = 1 To UBound(arr_sheet)
   my_name = Sheets(arr_sheet(i)).Name
   x = Len(my_name)
   If x = 0 Then
   Sheets("statment").Copy Before:=Sheets("statment")
   ActiveSheet.Name = arr_sheet(i)
   End If
   Next
Erase arr_sheet
  End Sub