Daten nach Entscheidung in anderes Blatt schreiben

[appelschnut]

Hallo liebe Leute,

ich habe ein Problem. Ich bin in VBA leider nicht fit und teste gerade herum.

Ich möchte das aus Tabelle 1 Spalte E reihenweise untersucht wird.
Ist der Wert in Zelle E1 ungerade sollen die Zellen E1,J1 und H1 in Tabelle "Ungerade" in die Zellen B1,B2 und B3 kopiert werden.
Ist der Wert in Zelle E1 gerade sollen die Zellen E1, F1 und I1 in Tabelle "Gerade" in die Zellen B1, B2 und B3 kopiert werden.
Danach soll der Wert E2 untersucht werden. Je nach Ergebnis soll wieder in die entsprechende Tabelle geschrieben werden, wobei jetzt darauf geachtet werden muss, ob in "Gerade":B1 schon belegt ist. Dann muss in C1,C2 und C3 geschrieben werden.

So soll es weiter gehen, bis eine Zelle der Spalte E leer ist.

Eine Sup, in der die neuen Tabellenblätter angelegt werden habe ich schon erstellt. Es wird auch vorher ein eventuell schon vorhandenes, gleichnamiges Blatt gelöscht.

Könnt ihr mir einen Anstoß geben, damit ich nicht ewiglich im Dunklen tappe?

Vielen Dank

[appelschnut]

Hallo nochmals,

ich habe das Problem jetzt schon ein Stückweit abgearbeitet. Ich habe nur noch das Problem, dass ich die Daten übertragen muss.
Ich möchte eine Zelle prüfen. Wenn der Wert der Zelle gerade ist, soll in das eine Tabellenblatt geschrieben werden. Wenn nicht, dann in das andere. Es sollen immer 3 Zellen kopiert werden. Ich habe mir folgende Schleife gebastelt, die aber leider nicht funktioniert:

While Not IsEmpty(Cells(iRow, 10))            *Abfrage ob in der Zelle überhaupt ein Wert eingetragen ist. Wenn nicht soll die Schleife nicht durchlaufen werden, da die Tabelle am Ende angekommen ist
    If Cells(iRow, 10) Mod 2 = 0 Then         * Prüfen, ob der Wert gerade ist oder nicht.Wenn ja, geht es hier weiter...
    xRow1 = 1
    Sheets("Gerade").Cells(xRow1, xColumn1) = Sheets(1).Cells(iRow, 10)
    xRow1 = xRow1 + 1
    Sheets("Gerade").Cells(xRow1, xColumn1) = Sheets(1).Cells(iRow, 6)
    xRow1 = xRow1 + 1
    Sheets("Gerade").Cells(xRow1, xColumn1) = Sheets(1).Cells(iRow, 9)
    xColumn = xColumn + 1
    Else                                                     *...wenn nicht, dann hier fortsetzen
    xRow1 = 1
    Sheets("Ungerade").Cells(xRow1, xColumn1) = Sheets(1).Cells(iRow, 10)
    xRow1 = xRow1 + 1
    Sheets("Gerade").Cells(xRow1, xColumn1) = Sheets(1).Cells(iRow, 5)
    xRow1 = xRow1 + 1
    Sheets("Gerade").Cells(xRow1, xColumn1) = Sheets(1).Cells(iRow, 8)
    xColumn = xColumn + 1
    End If
    iRow = iRow + 1
Wend

Ich hoffe da blickt jemand von euch Profis durch und versteht meinen Ansatz und mein Ziel.

Vielen Dank

[IchBinIch]

Hi,

ich habe mal dieses Testszenario aufgebaut.

Test

	A	B	C
1	4	abd	gkkg
2	1	dglgj9	ghhf
3	6	fspifif	677
4	5	dgi	jjjg
5	12	ktkeit	567j

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

Und die Daten mit diesem Makro verteilt

Sub PrüfungGeradeUngerade()
Dim z As Long, g As Long, u As Long

g = 1
u = 1

With Sheets("Test")
    For z = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
        If WorksheetFunction.IsEven(.Range("A" & z)) Then
            .Range("A" & z, "C" & z).Copy Sheets("Gerade").Range("A" & g)
            g = g + 1
        Else
            .Range("A" & z, "C" & z).Copy Sheets("Ungerade").Range("A" & u)
            u = u + 1
        End If
    Next z
End With
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Ergebnis
Gerade

	A	B	C
1	4	abd	gkkg
2	6	XXX	677
3	12	ktkeit	567j

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

Ungerade

	A	B	C
1	1	dglgj9	ghhf
2	5	dgi	jjjg

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

Gruß
Ich

[appelschnut]

Vielen Dank für deine Antwort.

Leider funktioniert das Script bei mir nicht. Ich habe es kopiert und wollte nur die Spalte von A auf E ändern. Sofort kam eine Fehlermeldung "Ausdruck erwartet"

Hast du auch dafür noch eine Idee?

[IchBinIch]

Hi,

am einfachsten ist es immer, wenn der TS eine Beispieldatei zur Verfügung stellt.
Wenn man als Helfer selbst etwas baut, geht das erfahrungsgemäß oft daneben.
Deshalb meine Bitte: Stell doch eine Datei bereit.
Wie das geht, findest Du hier.

Gruß
Ich

[appelschnut]

Vielen Dank nochmals,

Habe das Problem gefunden. Funktioniert jetzt.

Thread erledigt!