|
Hallo abblgribsch,
ich habe Dir das jetzt mal schnell umgebastelt, es ist aber nicht getestet. Du musst auch noch den Pfad bzw. Dateinamen im Code anpassen.
Der Code macht ein Update auf "Wegfälle.Xls", es werden also immer die neu gelöschten Namen hinzugefügt, die alten werden nicht überschrieben. Es ist auch eine Meldung drin, falls der Name nicht gefunden werden kann.
Sub Delete()
Dim VN_Name
Dim VName As String
Dim NName As String
Dim c As Range, i As Integer
Dim Gelöscht As Boolean
Gelöscht = False
Application.ScreenUpdating = False
VN_Name = InputBox("Bitte Vor- und Nachname eingeben", Default:="Hans Meier") 'Namen eingeben
VName = Split(VN_Name)(0)
NName = Split(VN_Name)(1)
For i = 1 To Worksheets.Count
Worksheets(i).Activate
For Each c In ActiveSheet.Range("C:C").SpecialCells(xlTextValues)
If c.Value = NName And c.Offset(0, 1).Value = VName Then '
Workbooks.Open Filename:="[Datenpfad einfügen]Wegfälle.xls"
Workbooks("[Mappenname einfügen]").Activate
ActiveSheet.Range(Cells(c.Row, 1), Cells(c.Row, ActiveSheet.UsedRange.Columns.Count)).Copy
Workbooks("Wegfälle.xls").Sheets(1).Cells(UsedRange.Row + 1, 1).PasteSpecial
c.EntireRow.Cells.SpecialCells(xlCellTypeConstants).ClearContents
Gelöscht = True
Exit For
End If
Next
Next i
Application.ScreenUpdating = True
If Gelöscht = True Then
MsgBox ("Name wurde gelöscht")
Else
MsgBox ("Name wurde nicht gefunden")
End
End Sub
Sag mal Bescheid ob es funktioniert, liebe Grüße
Y
PS: Bist Du Dir dessen bewusst, dass der jetzige Code alle "Hans Meier" löscht, die in der Tabelle vorkommen? Soll das so?
|