VBA Zeile in andere Datei kopieren

Question

Hallo,

ich habe bereits folgenden Code bei den in allen Tabellenblättern nach einem Namen gesucht und anschließend gelöscht wird:


Sub Delete()

Dim VN_Name
Dim VName As String
Dim NName As String
Dim c As Range, i As Integer

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 '
c.EntireRow.Cells.SpecialCells(xlCellTypeConstants).ClearContents

Exit For
End If
Next
Next i
Application.ScreenUpdating = True
MsgBox("Name wurde gelöscht")
End Sub

Nun soll diese gefundenen Zeilen in eine identische Datei als Sicherung eingehen. Kann man das irgendwie realisieren?
Hab schon was in Richtung EntireRow.copy gelesen aber weiter bin ich leider noch nicht, kann mir da jemand helfen?

Answer 1

Hallo abblgribsch!
Da ich nicht weiß, an welcher Stelle die gesicherte Zeile in der anderen Datei eingefügt werden soll, habe ich mich dafür entschieden die kopierte Zeile immer in die erste freie Zeile einzufügen. Das Makro sieht dann wie folgt aus:
Kopiere das Makro in Deine Datei.
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei, da ich das Makro nicht getestet habe.

Sub Delete()

Dim VN_Name
Dim VName As String
Dim NName As String
Dim c As Range, i As Integer

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 '
'Zeile kopieren
Rows(c.Row).Copy
'kopierte Zeile in andere Datei in Blatt mit dem gleichen Namen, wie das aktive Tabellenblatt, einfügen
Workbooks("Der Dateiname").Sheets(i).Cells(Sheets(i).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row, 1).PasteSpecial

c.EntireRow.Cells.SpecialCells(xlCellTypeConstants).ClearContents
Exit For
End If
Next
Next i
Application.ScreenUpdating = True
MsgBox ("Name wurde gelöscht")
End Sub Soll die kopierte Zeile in die gleiche Zeilenummer kopiert werden, aus der Sie gelöscht wurde, dann musst Du die Zeilen
'Zeile kopieren
Rows(c.Row).Copy
'kopierte Zeile in andere Datei in Blatt mit dem gleichen Namen, wie das aktive Tabellenblatt, einfügen
Workbooks("Der Dateiname").Sheets(i).Cells(Sheets(i).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row, 1).PasteSpecial löschen und dafür die Zeilen
'Zeile kopieren
Rows(c.Row).Copy
'kopierte Zeile in andere Datei in Blatt mit dem gleichen Namen, wie das aktive Tabellenblatt, einfügen
Workbooks("Der Dateiname").Sheets(i).Cells(c.Row, 1).PasteSpecial einfügen.

Egal welche Methode Du nun bevorzugst, in beiden Fällen muss die Datei, in die die Zeile kopiert werden soll geöffnet sein und Du mußt noch den Dateinamen „Der Dateiname“ gegen den Namen Deiner Datei austauschen.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 2

Hallo,

ja es sollte in die erste leere Zeile kopiert werden, klappt auch gut aber er sucht in der falschen Spalte, er müsste in Spalte C suchen.

Schätze mal das regelt diese Zeile:

Workbooks("Der Dateiname").Sheets(i).Cells(Sheets(i).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row, 1).PasteSpecial

Soweit ich weiß müsste ich ja bloß die Zahl hinter rows.Count und Row auf 3 ändern, liege ich da richtig?
Was mich noch ein wenig stört ist das ich wohl die Datei wohin kopiert werden soll vorher manuell öffnen muss?
Da ist schätze mal

Workbooks.Open Filename:="C:\Mappe2.xls"

und das selbe mit close das richtige. Aber wohin damit? Vor und nach den For Schleifen?

Danke nochmal für deine Hilfe. :)

Answer 3

Hallo abblgribsch!

Wenn Du Dir Deinen Code aus Deiner Frage und den Code, den ich in AW1 aufgeführt habe mal ansiehst, so siehst Du, dass ich an Deinem Code nichts geändert, sondern nur 2 Zeilen hinzugefügt habe. Da das Suchen ja vorher funktioniert hat, sollte es auch weiterhin funktionieren. Wenn es nun nicht mehr funktioniert, hat es das vorher auch nicht.
Mit der Zeile

Workbooks("Der Dateiname").Sheets(i).Cells(Sheets(i).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row, 1).PasteSpecial wird, wie auch aus meinem Kommentar im VBA-Code oberhalb dieser Zeile ersichtlich, die vorher kopierte Zeile eingefügt. Eingefügt wird die Zeile in die erste Spalte, also Spalte A, in der ersten freien Zeile. Das muss auch so sein, denn anders geht es nicht. Eine Zeile hat 256 Spalten. Kopiert man eine gesamte Zeile, so kopiert man von einer Zeile die Spalten A bis IV. Das muss dann natürlich auch wieder so eingefügt werden, dass Zelle A in Zelle A, Zelle B in Zelle B usw. bis zur Zelle IV kopiert wird.

Nachfolgend der Code soweit abgeändert, dass vorher die Datei „Mappe2.xls“ geöffnet wird, dann durch Deinen alten Code theoretisch die Daten kopiert und gelöscht werden und am Ende wird die geöffnete Datei gespeichert und geschlossen. Die Änderungen, die ich an Deinem alten VBA-Code durchgeführt habe, beziehen sich nur darauf, dass ich Dateinamen vor die einzelnen Befehle gesetzt habe und somit direkt die Dateien anspreche.

Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Const strQuellDat As String = "C:\Mappe2.xls"

Sub Delete()

Dim VN_Name
Dim VName As String
Dim NName As String
Dim c As Range, i As Integer

Dim wkbQuelldatei As Workbook
Dim wkbZieldatei As Workbook

On Error GoTo ERRORHANDLER

Application.ScreenUpdating = False

Set wkbQuelldatei = ThisWorkbook
Set wkbZieldatei = GetObject(strQuellDat)
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 wkbQuelldatei.Worksheets.Count
wkbQuelldatei.Worksheets(i).Activate
For Each c In wkbQuelldatei.Sheets(i).Range("C:C").SpecialCells(xlTextValues)
If wkbQuelldatei.Sheets(i).c.Value = NName And wkbQuelldatei.Sheets(i).c.Offset(0, 1).Value = VName Then '
'Zeile kopieren
wkbQuelldatei.Sheets(i).Rows(c.Row).Copy
'kopierte Zeile in andere Datei in Blatt mit dem gleichen Namen, wie das aktive Tabellenblatt, einfügen
wkbZieldatei.Sheets(i).Cells(Sheets(i).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row, 1).PasteSpecial

wkbQuelldatei.Sheets(i).c.EntireRow.Cells.SpecialCells(xlCellTypeConstants).ClearContents
Exit For
End If
Next
Next i

wkbZieldatei.Close True

Application.ScreenUpdating = True
MsgBox ("Name wurde gelöscht")

ERRORHANDLER:
Set wkbQuelldatei = Nothing
Set wkbZieldatei = Nothing

End Sub Auch diesen Code habe ich nicht getestet, da ich keine Lust habe mir Deine Datei nachzubauen. Sollte es nicht funktionieren, so müsstest Du Deine Datei z.B. mal http://www.file-upload.net/ hochladen und den Link, den Du dann erhältst hier posten. Dann kann man sich das in deiner Datei ansehen.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 4

Hallo,

ich weiß das du bei meinem Code nichts verändert hast, es scheint so als würde er meine Schleife einfach überspringen. Bekomme auch keine fehlermeldung oder dergleichen. Macro läuft durch aber es geschieht nichts. Hier mal die Datei:

http://www.file-upload.net/download-4031037/probe.xls.html

Und wieder einmal Danke.

Answer 5

Achso, was ich vergessen habe, das Macro heißt "Delete" da mehrere vorhanden sind, das du wenigstens nicht so suchen musst.