Office: (Office 2010) Zellen kopieren und in die nächste freie Zeile kopieren

momo66 · 28. Oktober 2017

Hallo,

eine kurze Frage. Ich komme ums verrecken nicht weiter. Ich möchte von einem dynamischen Tabellenblatt alle Daten kopieren und sie in eine bestehendes kopieren und zwar in die nächste freie Zeile. Bisher habe ich es geschafft dass die gewünschten Spalten kopiert und eingefügt werden jedoch nicht in die nächste freie ziele bzw. zelle.

Code:

Private Sub CommandButton1_Click()

Dim zeile As Long
Dim zeilemax As Long
Dim n As Long

With ActiveWorkbook.Sheets("Investigation " & Date)
zeilemax = .UsedRange.Rows.Count

n = 2

MsgBox zeilemax, vbOKOnly

'Dim rwindex As Long
'For rwindex = 1 To .Cells(65356, 1).End(xlUp).Row

For zeile = 2 To zeilemax

If .Cells(zeile, 1).Value = "Unit" Then

.Cells(zeile, "A").Copy Destination:=ActiveWorkbook.Sheets(2).Cells(n, "A")
.Cells(zeile, "B").Copy Destination:=ActiveWorkbook.Sheets(2).Cells(n, "B")
.Cells(zeile, "C").Copy Destination:=ActiveWorkbook.Sheets(2).Cells(n, "C")
.Cells(zeile, "D").Copy Destination:=ActiveWorkbook.Sheets(2).Cells(n, "D")
.Cells(zeile, "E").Copy Destination:=ActiveWorkbook.Sheets(2).Cells(n, "E")
.Cells(zeile, "F").Copy Destination:=ActiveWorkbook.Sheets(2).Cells(n, "F")
.Cells(zeile, "G").Copy Destination:=ActiveWorkbook.Sheets(2).Cells(n, "G")
.Cells(zeile, "H").Copy Destination:=ActiveWorkbook.Sheets(2).Cells(n, "H")

n = n + 1
End If
Next zeile

End With

MsgBox "ende", vbOKOnly
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

Hasso · 30. Oktober 2017

Hallo momo66,

bei mir funktioniert das so: Code:

Option Explicit

Private Sub CommandButton1_Click()

Dim zeile As Long
Dim zeilemax As Long
Dim n As Long

If Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row 1 Then
n = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1
Else
'Wenn Sheet2 noch leer ist:
n = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
End If
With ActiveWorkbook.Sheets("Investigation " & Date)
zeilemax = .UsedRange.Rows.Count
For zeile = 2 To zeilemax
If .Cells(zeile, 1).Value = "Unit" Then
.Range(.Cells(zeile, "A"), .Cells(zeile, "H")).Copy Destination:=ActiveWorkbook.Sheets(2).Cells(n, "A")
n = n + 1
End If
Next zeile

End With

MsgBox "ende", vbOKOnly
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Allerdings würde ich dir empfehlen für das Zielblatt nicht die Blattnummer "Sheets(2)" zu nehmen, sondern den Blattnamen. Wenn jemand sonst mal das Blatt an eine andere Position schiebt, landen deine Daten in der falschen Tabelle.

Jonas0806 · 30. Oktober 2017

Hallo,

ich würde das so machen:

Code:

Option Explicit

Private Sub CommandButton1_Click()
Dim zeile As Long
Dim wksTarget As Worksheet, wksSource As Worksheet

Set wksSource = ActiveWorkbook.Sheets("Investigation " & Date)
Set wksTarget = ActiveWorkbook.Sheets(2)

With wksSource
For zeile = 2 To .UsedRange.Rows.Count
If .Cells(zeile, 1).Value = "Unit" Then
wksTarget.Cells(wksTarget.UsedRange.Rows.Count + 1, 1).Resize(1, 8).Value = .Cells(zeile, 1).Resize(1, 8).Value
End If
Next zeile
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Bei größeren Datenmengen würde ich die Daten vorher in ein Array schreiben und dann das komplette Array in die Tabelle schreiben.

momo66 · 2. November 2017

Euch beiden vielen lieben Dank

momo66 · 2. November 2017

Also ich hätte da doch noch eine Frage. Und zwar beide codes erfüllen irgendwie nur ein Teil der Anforderung. Code eins kopiert zwar in die richtige Zeile jedoch überschreibt dieser falls ich das zweite mal das makro durchlaufen lasse. Code zwei hingegen schreibt da weiter wo er eine freie zeile findet jedoch ziemlich weit unten.

Es war mein Fehler folgendes nicht erwähnt zu haben.
1. Also ich will aus Investigation Sheet in Sheet 2 die Daten übertragen. Die erste Zeile von Sheet 2 ist bereits ausgefüllt mit den Spalten "Unit"; "ID"; "ID_"; "Name".

2. Die Daten aus investigation sheet soll nun in Sheet 2 aber zeile 2 übertragen warden.

3. Falls da nun weitere Daten aus Investigation Sheet in Sheet 2 übertragen warden sollen. Sollen die bestehenden Daten in Sheet 2 nicht überschrieben warden sondern dort weiterschreiben wo er aufgehört hat.

:S ich hoffe, dass ich es einigermaßen verständlich rüberbringen konnte.

Hasso · 2. November 2017

Hallo momo66,

am besten wäre es, wenn du deine Mappe mal hier hochladen würdest. Dann könnte man das einfacher angehen.

Office: (Office 2010) Zellen kopieren und in die nächste freie Zeile kopieren

Zellen kopieren und in die nächste freie Zeile kopieren

Zellen kopieren und in die nächste freie Zeile kopieren

Zellen kopieren und in die nächste freie Zeile kopieren

Zellen kopieren und in die nächste freie Zeile kopieren - Similar Threads - Zellen kopieren Zeile

Zellen aus Aktiver Zeile kopieren

Wenn in Zeile bestimmter Wert dann ganze Zelle kopieren

Zeilen aufgrund von bestimmten Informationen in anderes Tabellenblatt kopieren

VBA Makro, einzelne Zellen kopieren und in fortlaufende Zeile einfügen

Leere Zellen suchen und Zeilen kopieren

Verschieben oder Kopieren von Zellen, Zeilen und Spalten

Kopiere den Inhalt einer Zelle nachdem 2 andere Zeilen verglichen wurden