Sub Deleteneu() Dim VN_Name Dim VName As String Dim NName As String Dim c As Range, i As Integer Dim Gelöscht As Boolean Dim kw As String Gelöscht = False Workbooks.Open Filename:="F:\Wegfälle.xls" Workbooks("testvariante.xls").Activate 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(Cells(1, 3), Cells(Rows.Count, 3).End(xlUp)) If c.Value = NName And c.Offset(0, 1).Value = VName Then ActiveSheet.Range(Cells(c.Row, 1), Cells(c.Row, ActiveSheet.UsedRange.Columns.Count)).Copy kw = ActiveSheet.Name Workbooks("Wegfälle.xls").Activate Workbooks("Wegfälle.xls").Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = kw Workbooks("Wegfälle.xls").Sheets(1).Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues Workbooks("testvariante.xls").Activate Cells(c.Row, 1).EntireRow.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 If End Sub
58.4k Fragen
249k Antworten
7k Nutzer