VBA Prozedur erstellen

Hallo VBA-Experten,
wer von euch kann mir bei der Erstellung einer Prozedur behilflich sein, die
folgendes bewirken sollte:
Ich möchte, dass aus der Tabelle1 die in Spalte A in den Zellen ab Zeile 5 befindlichen Werte, nur dann in eine neue Tabelle2 (Spalte C ab Zeile 5) kopiert werden, wenn in Spalte B der Tabelle1 in der gleichen Zeile ein "x" eingetragen ist. Der Kopiervorgang soll entsprechend dem in Tabelle1 Zelle A1 eingetragenen Wert für die entsprechende Anzahl Spalten rechts von B weitergeführt werden.
Also steht in Zelle A1 der Wert (die Zahl 4) sollten nach Spalte B nacheinander noch drei weitere Spalten (C, D, E) auf das Vorkommen von "x" geprüft werden, und wenn vorhanden, die Werte aus Spalte A der gleichen Zeile in die Tabelle2 dann in die Spalten D, E sowie F ab Zeile 4 kopiert werden.

Für eure Hilfen besten Dank.

Mfg
Fritz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub rüberschupfen() Dim zt1 As Integer Dim zt2 As Integer zt1 = 5 zt2 = 5 Do Until Tabelle1.Cells(zt1, 1) = "" If Cells(zt1, 2) = "x" Then Tabelle2.Cells(zt2, 3) = Tabelle1.Cells(zt1, 1) If Tabelle1.Cells(zt1, 3) = "x" Then Tabelle2.Cells(zt2, 4) = Tabelle1.Cells(zt1, 1) If Tabelle1.Cells(zt1, 4) = "x" Then Tabelle2.Cells(zt2, 5) = Tabelle1.Cells(zt1, 1) If Tabelle1.Cells(zt1, 5) = "x" Then Tabelle2.Cells(zt2, 6) = Tabelle1.Cells(zt1, 1) zt2 = zt2 + 1 End If zt1 = zt1 + 1 Loop End Sub

Hallo Heinz,
danke für die Hilfe.
Ich habe die Aufgabe zu unpräzise formuliert, deshalb leistet die Prodzedur nur zum Teil das, was ich eigentlich erreichen will.
Zunächst noch einmal die Eigenschaften, die die von Dir geschriebene Prozedur in meinem Sinn leistet:
Die Namen aus Spalte A der Tabelle1 werden in die Spalte C der Tabelle2 geschrieben, wenn die entsprechende Zeile der Spalte B in Tabelle1 ein "x" enthält. Korrekt ist auch, dass bei "x" in Spalte C der Tabelle1 nach Spalte D der Tabelle2 kopiert wird. Allerdings sollte dabei alle Namen aus Spalte A der Tabelle1 erscheinen, denen eben in der entsprechenden Zeile in Spalte C Tabelle1 das "x" zugeordnet ist und zwar durchgehend von Zeile 5 nacheinander der Reihe nach in der Spalte D (es sollten also in der Tabelle2 keine leeren Zeilen zwischen Namen finden.
Wenn Du meine Ausführungen verstanden hast und mir die Prozedur dementsprechend anpassen kannst, würde ich mich freuen. Notfalls könnte ich auch eine Beispieldatei hochladen, in der ich "von Hand" ein gewünschtes Ergebnis in die Tabelle2 schreiben würde.
Wie auch immer, ich bedanke mich bereits an dieser Stelle für Deine Mühen.
Mfg Fritz

Vielleicht kannst Du mir die Prozedur noch anpassen, wenn ich Dir

Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo fehlermeldung Dim z1 As Integer Dim z2 As Integer Dim sp1 As Integer Dim sp2 As Integer z1 = 5 sp2 = Tabelle1.Cells(1, 1).Value + 1 Tabelle2.Range("a1:ag2000").ClearContents Do Until Tabelle1.Cells(z1, 1) = "" For sp1 = 2 To sp2 If LCase(Tabelle1.Cells(z1, sp1).Text) = "x" Then z2 = 5 Do Until Tabelle2.Cells(z2, sp1 + 1) = "" z2 = z2 + 1 Loop Tabelle2.Cells(z2, sp1 + 1) = Tabelle1.Cells(z1, 1).Text End If Next sp1 z1 = z1 + 1 Loop Exit Sub fehlermeldung: MsgBox "Ein Fehler ist aufgetreten. Überprüfen Sie alle Eingaben. Das Programm kann nicht weiter ausgeführt werden." End Sub

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread