Bestimmte Zellen kopieren nach Überprüfung
23.03.2016 08:31:36
Bekks
Ich habe im Internet für mein Problem schon folgenden Code gefunden.
Sub pruefen()
ende = ActiveSheet.UsedRange.Rows.Count
For Each zelle In Tabelle1.Range("B1:B" & ende)
On Error Resume Next
If Not IsEmpty(zelle) Then
zelle.EntireRow.Select
Selection.Copy
Rows(ActiveSheet.UsedRange.Rows.Count + 1).Select
ActiveSheet.Paste
Tabelle1.Cells(ActiveSheet.UsedRange.Rows.Count, 1).Value = zelle.Value
Tabelle1.Cells(ActiveSheet.UsedRange.Rows.Count, 2).Value = ""
End If
Next zelle
End Sub
Ich habe Tabelle 1 als Ausgangsdaten und
Tabelle 2 soll mit Daten aus Tabelle 1 gefüllt werden.
Dazu soll in Tabelle 1 in der Spalte E ab Zeile 2 überprüft werden ob diese Zelle nicht leer ist.
Ist die Zelle gefüllt soll der Kopiervorgang gestartet werden.
Diese Überprüfung soll mit allen Daten geschehen,
die Kopierten Werte sollen in Tabelle 2 aber untereinander also ohne Lücke eingefügt werden.
Der Kopiervorgang soll wie folgt aussehen:
Aus der ausgewählten Zeile sollen Spalte B,C und D der Tabelle 1 in die Spalten D, E und F der Tabelle 2 kopiert werden.
Spalte E der Tabelle 1 soll in Spalte G der Tabelle 2.
Da ich später ein zweites Arbeitsblatt machen möchte sollte E "Variabel" sein, da dort dann auf G geprüft werden soll und G der Tabelle 1 dann in G der Tabelle 2 geschrieben werden soll.
Als Zusatz wäre noch meine Frage ob es möglich ist beim Kopieren nach einer bestimmten Anzahl, sagen wir z.B. 30 Stück, eine Zeile leer zu lassen und den Kopiervorgang erst in der nächsten Zeile wieder fortzuführen?
Danke im Voraus :)
LG Bekks!