Wenn in Zeile ein Wert, dann kopieren

Hallo,
ich habe folgendes Problem. Ich möchte gerne aus verschiedenen worksheets (Montag, Dienstag, Mittwoch, Donnerstag, Freitag) einen Wert z.B. 8a nacheinander Zeilen (insgesamt 12 Zeilen, 100 Spalten) durchsuchen lassen und dann in einer Tabelle1 in die erste Spalte den zuerst gefundenen Wert, in die zweite Spalte den zweiten gefundenen Wert und den dritten Fund in die dritte Spalte kopieren. Das muss zeilenweise funktionieren. Mit VBA wird es wahrscheinlich was kurzes sein. Ich bedanke mich schon im Voraus für die Hilfe.
BEISPIEL:
WorksheetMontag
Spalte1. / Spalte 2. /Spalte 3. /Spalte4. /..........
Zeile1 leer. / 8a groß. /leer. /leer. /leer. /8a muster. / leer ...
Zeile 2. 8a Meier. /leer. /leer. /8a. / leer. /leer. / 8a Schneider
Ziel Tabelle 1
Spalte1. /Spalte2. /Spalte3.
8a Groß. /8a Muster. / leer
8a Meier. /8a. /8a Schneider
....

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Schaltfläche1_Klicken() Dim varBlätter As Variant, i As Long, a As Long, x As Long, y As Long, z As Long varBlätter = Array("Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag") For i = LBound(varBlätter) To UBound(varBlätter) a = 6 With Worksheets(varBlätter(i)) For x = 4 To .Cells(.Rows.Count, "A").End(xlUp).Row y = 2 + 2 * i For z = 2 To 73 If Left(.Cells(x, z), 2) = "8A" Then Worksheets("Tabelle1").Cells(a, y + i) = .Cells(x, z) Worksheets("Tabelle1").Cells(a + 1, y + i) = .Cells(2, z) y = y + 1 End If Next z a = a + 2 Next x End With Next i End Sub

Hallo Werner,
du warst mir eine große Hilfe. Danke für die Mühe!
Ich habe eine kleine Veränderung vorgenommen, damit ich das Suchkriterium in Tabelle1 (A1) eingeben kann und mit einer eingefügten Schaltfläche das Makro aufrufe. Zudem lösche ich vorher die beschriebenen Zellen.
Das mit dem Raum, der oberhalb der ausgegeben Klasse erscheinen soll, habe ich gelassen. Wie gesagt, es wäre ein Schmankerl ;-) und ich wollte es nicht mit einer Formel. Ich denke, es könnte man auch in das Makro packen. Wie, weiß ich nicht.
Dim varBlätter As Variant, i As Long, a As Long, x As Long, y As Long, z As Long
varBlätter = Array("Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag")
With Worksheets("Tabelle1")
.Range("B4:P15").ClearContents
End With
For i = LBound(varBlätter) To UBound(varBlätter)
a = 1
With Worksheets(varBlätter(i))
For x = 4 To .Cells(.Rows.Count, "A").End(xlUp).Row
y = 2 + 2 * i
For z = 2 To 73
If Left(.Cells(x, z), 3) = Range("A1") Then
Worksheets("Tabelle1").Cells(a, y + i) = .Cells(x, z)
Worksheets("Tabelle1").Cells(a + 1, y + i) = .Cells(2, z)
y = y + 1
End If
Next z
a = a + 2
Next x
End With
Next i
End Sub

Beliebteste Forumthreads (12 Monate)

Wenn in Zeile ein Wert, dann kopieren

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

336 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wenn in Zeile ein Wert, dann kopieren

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

336 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread