Mittels VBA aus div. Tabellen neue Tabellen füllen

Hallo Experten,
ich habe mich mit meinen offensichtlich zu geringen VBA-Kenntnissen an eine Aufgabe herangewagt, die ich alleine nicht bewältigen kann. Nach stundenlangen
Herumdoktern habe ich aufgegeben. Ich beschreibe euch einmal die Aufgabenstellung und hoffe, dass ich mit eurer Hilfe doch noch eine Lösung finde.
In drei identischen Tabellen (Tabellenblätter "P1", "P2" und "P3" befinden sich in den Spalten B, C und D (jeweils ab Zeile 4) Datensätze, die in Abhängigkeit einer Angabe in der entsprechenden Zeile in Spalte E (dort können die Angaben V1 oder V2 stehen) in bereits bestehende Tabellenblätter "V1" bzw. "V2" ebenfalls jeweils ab Zeile in die Spalten B bis D (als entsprechender Datensatz übernommen wird. Das heißt also die Tabelle "V1" der Reihe nach mit den Datensätzen füllen, bei denen in der jeweiligen Zeile in den Tabellen "P1", "P2" oder "P3" in Spalte E "V1" vermerkt ist (entsprechendes gilt für die Tabelle "V2". In der jeweiligen Zeile in Spalte E soll in den Tabellen "V1" bzw. "V2" mit der Angabe P1, P2 oder P3 ein Hinweis auf die "Herkunft" des jeweiligen Datensatzes gegeben werden.
Hoffentlich habe ich die Aufgabe verständlich beschrieben und hoffe auch, dass ich auch von euch Experten hier nicht zuviel verlange.
Umso erfreulicher natürlich, wenn Ihr mir helfen könnt. Danke bereits im Voraus.
Mfg Frieder

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub fillSheets() Dim lV1_cnt, lV2_cnt As Integer Dim l_sheetname As String 'Zielbereiche leeren For i = 1 To 2 Sheets("V" & CStr(i)).Range("B4:D65536") = "" Next i lV1_cnt = 0 lV2_cnt = 0 'Zielbereiche füllen For j = 1 To 3 For k = 4 To 65536 l_sheetname = Sheets("P" & CStr(j)).Cells(k, 5) If IsNull(CVar(l_sheetname)) Or _ IsEmpty(CVar(l_sheetname)) Or _ l_sheetname = "" Then Exit For ElseIf l_sheetname = "V1" Then lV1_cnt = lV1_cnt + 1 For l = 2 To 4 Sheets(l_sheetname).Cells(lV1_cnt + 3, l) = Sheets("P" & CStr(j)).Cells(k, l) Next l Sheets(l_sheetname).Cells(lV1_cnt + 3, 5) = "P" & CStr(j) ElseIf l_sheetname = "V2" Then lV2_cnt = lV2_cnt + 1 For m = 2 To 4 Sheets(l_sheetname).Cells(lV2_cnt + 3, m) = Sheets("P" & CStr(j)).Cells(k, m) Next m Sheets(l_sheetname).Cells(lV2_cnt + 3, 5) = "P" & CStr(j) End If Next k Next j End Sub

Hallo,
bin gestern schon nach Hause gegangen und hab'mir erst jetzt Deine Antworten angesehen.

Nachfolgend noch einmal der Code mit ein wenig mehr Kommentaren, um darzustellen, was passiert.

Wenn gar nicht passiert, heisst das, dass die Schleifenabbruchbedingungen sofort erfüllt werden.
Bitte prüfen:
1. Deine Quellblätter heißen P1, P2 und P3
2. Deine Zielblätter heißen V1 und V2
3. In Spalte "E" der Quellblätter steht immer, wohin die Daten der aktuellen Zeile sollen (V1, V2)

Viel Erfolg,
Nayus

#################################################################


Sub fillSheets()
Dim lV1_cnt, lV2_cnt As Integer
Dim l_sheetname As String
'Zielbereiche leeren
For i = 1 To 2
Sheets("V" & CStr(i)).Range("B4:D65536") = ""
Next i
lV1_cnt = 0
lV2_cnt = 0
'Zielbereiche füllen
' Schleife durch die Originalblätter (P1, P2, P3)
For j = 1 To 3
' Pro Blatt Schleife durch die Datenzeilen (4 bis Blattende)
For k = 4 To 65536
'Zielblattname in eine Variable schreiben (zur weiteren Verwendung)
' Anmerkung: In Spalte 5, also E, muss "V1" oder "V2" stehen!
l_sheetname = Sheets("P" & CStr(j)).Cells(k, 5)
If IsNull(CVar(l_sheetname)) Or _
IsEmpty(CVar(l_sheetname)) Or _
l_sheetname = "" Then
'Wenn in der Quelltabelle in Spalte E nichts steht...
Exit For
' nächtes Quellblatt abarbeiten
ElseIf l_sheetname = "V1" Then
' Zieltabelle V1
lV1_cnt = lV1_cnt + 1
For l = 2 To 4
'Inhalt der Spalten B, C und D in die nächste freie Zeile der Zieltabelle kopieren
Sheets(l_sheetname).Cells(lV1_cnt + 3, l) = Sheets("P" & CStr(j)).Cells(k, l)
Next l
' In Spalte E den Namen des Quellarbeitsblattes einfügen
Sheets(l_sheetname).Cells(lV1_cnt + 3, 5) = "P" & CStr(j)
ElseIf l_sheetname = "V2" Then
lV2_cnt = lV2_cnt + 1
' siehe vorheriges "elseif", jedoch für Zieltabelle V2
For m = 2 To 4
Sheets(l_sheetname).Cells(lV2_cnt + 3, m) = Sheets("P" & CStr(j)).Cells(k, m)
Next m
Sheets(l_sheetname).Cells(lV2_cnt + 3, 5) = "P" & CStr(j)
End If
Next k
Next j
End Sub

Beliebteste Forumthreads (12 Monate)

Mittels VBA aus div. Tabellen neue Tabellen füllen

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

231 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Mittels VBA aus div. Tabellen neue Tabellen füllen

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

231 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread