Sub DeleteErrName() On Error Resume Next Dim NSh As Name, i As Integer Dim OldStatus As Boolean, ThongBao As String OldStatus = Application.DisplayStatusBar Sheets.Add.Name = "ShName" For Each NSh In ActiveWorkbook.Names If InStr(1, NSh.RefersToR1C1, "#") > 0 Or _ InStr(1, NSh.RefersToR1C1, "\") > 0 Then i = i + 1 Application.StatusBar = "Deleted : " & Format(i, "#,##0") & _ " Deleting...: " & NSh.Name Sheets("ShName").Range("A" & i).Value = NSh.Name Sheets("ShName").Range("B" & i).Value = " " & NSh.RefersToR1C1 NSh.Delete End If Next If i > 0 Then _ ThongBao = ThongBao & Chr(13) & Chr(13) & " -" & Format(i, "#,##0") & " Names da xoa" MsgBox ThongBao, vbInformation, "GPE" Application.StatusBar = "" Application.DisplayStatusBar = OldStatus End Sub