Zeilen kopieren

Question

Hey,

ich wollte mit diesem Code Zeilen von einer Datei in eine andere kopieren und anschließend löschen, für mein bescheidenes wissen hat er keine Fehler, dennoch kopiert er nicht, jemand eine idee?
Hier der Code

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

Answer 1

Hallo,

das Makro kann man nur testen, wenn man auch die im Code angesprochenen Arbeitsmappen besitzt.

Einen Nachbau derselben, wir sich sicher keiner antun.

Gruß
Rainer