bestimmte Zellinhalte per Makro löschen

Sub Makro1()
' Makro1 Makro
' Tastenkombination: Strg+i
Dim lngLetzte As Long
Dim lngLetzte2 As Long
Dim lngIndex As Long
Dim vntArray As Variant
Dim strText As String
BilderRaus
With ActiveWorkbook.Worksheets("Tabelle1")
.Range("A:A,C:D").Delete Shift:=xlToLeft
With .Columns("A:A")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
lngLetzte = .Cells.Find(What:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
If Application.CountA(Worksheets("Tabelle4").Cells) = 0 Then
lngLetzte2 = 1
Else
lngLetzte2 = Worksheets("Tabelle4").Cells.Find(What:="*", _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End If
.Range(.Cells(1, 1), .Cells(lngLetzte, 1)).Copy _
Worksheets("Tabelle4").Cells(lngLetzte2 + 1, 1)
.Columns(1).Clear
End With
With ActiveWorkbook.Worksheets("Tabelle4")
With .Range(.Cells(lngLetzte2 + 1, 2), _
.Cells(.Cells(.Cells.Rows.Count, 1).End(xlUp).Row, 2)).Font
.Name = "Calibri"
.Size = 11
End With
strText = InputBox("Text für Spalte B:", "Eingabe", "Hier der Text")
If Not strText = vbNullString Then
.Range(.Cells(lngLetzte2 + 1, 2), _
.Cells(.Cells(.Cells.Rows.Count, 1).End(xlUp).Row, 2)) = strText
End If
lngLetzte2 = .Cells.Find(What:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
.Range(.Cells(1, 2), .Cells(lngLetzte2, 1)).Sort Key1:=.Range("A1:B1"), _
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
.Columns("A:A").EntireColumn.AutoFit
.Columns("B:B").EntireColumn.AutoFit
End With
HyperlinkAdressaenderung
End Sub