Zeile löschen, die #Bezug Fehler aufweist

Public Sub Mitarbeiter_löschen() Dim TabName As String TabName = InputBox("Geben Sie den zu löschenden Blattnamen ein:", "Mitarbeiter löschen") Index2 = 0: For Index = 5 To Worksheets.Count - 2 If Worksheets(Index).Name = TabName Then Index2 = 1 Next If Index2 = 0 Then TabName = MsgBox("Blattname nicht vorhanden", vbCritical + vbOKOnly): _ Exit Sub Application.ScreenUpdating = False: ThisWorkbook.Unprotect Password:=Kennwort Worksheets(TabName).Unprotect Kennwort: Worksheets(TabName).Delete Worksheets("Listen").Activate Index2 = MsgBox("Löschen Sie die Zeile mit den Bezugsfehlern !", vbExclamation + vbOKOnly) End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub Mitarbeiter_löschen() Dim TabName As String TabName = InputBox("Geben Sie den zu löschenden Blattnamen ein:", "Mitarbeiter löschen") Index2 = 0 For Index = 5 To Worksheets.Count - 2 If Worksheets(Index).Name = TabName Then Index2 = 1 Next If Index2 = 0 Then TabName = MsgBox("Blattname nicht vorhanden", vbCritical + vbOKOnly) Exit Sub End If With Application .ScreenUpdating = False .DisplayAlerts = False ThisWorkbook.Unprotect Password:=Kennwort Worksheets(TabName).Delete Worksheets("Listen").Activate Sheets("Listen").Cells.SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete .ScreenUpdating = True .DisplayAlerts = True End With End Sub

Hallo Joachim,
' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Sub Mitarbeiter_löschen()
    Dim strSheet As String
    Dim rng As Range, rngErr As Range, rngU As Range

    On Error GoTo ErrExit
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    strSheet = InputBox("Geben Sie den zu löschenden Blattnamen ein:", _
        "Mitarbeiter löschen")

    If strSheet = "" Then GoTo ErrExit

    If SheetExist(strSheet) Then
        Sheets(strSheet).Delete
        On Error Resume Next
        Set rngErr = Worksheets("Listen").UsedRange.SpecialCells( _
            xlCellTypeFormulas, 16)

        On Error GoTo ErrExit

        If Not rngErr Is Nothing Then
            For Each rng In rngErr
                If rng.Value = CVErr(xlErrRef) Then
                    If rngU Is Nothing Then
                        Set rngU = rng.EntireRow
                    Else
                        Set rngU = Union(rngU, rng.EntireRow)
                    End If
                End If
            Next
        End If

        If Not rngU Is Nothing Then rngU.Delete
    Else
        MsgBox "Blattname nicht vorhanden", vbInformation + vbOKOnly
    End If

    ErrExit:

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

Private Function SheetExist(ByVal sheetName As String, Optional WbName As String) As Boolean
    Dim wks As Worksheet
    On Error GoTo ERRORHANDLER
    If WbName = "" Then WbName = ThisWorkbook.Name
    For Each wks In Workbooks(WbName).Worksheets
        If wks.Name = sheetName Then SheetExist = True: Exit Function
    Next
    ERRORHANDLER:
    SheetExist = False
End Function

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Zeile löschen, die #Bezug Fehler aufweist

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeile löschen, die #Bezug Fehler aufweist

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread