Wenn Zellen Werte enthalten, dann kopiere andere Zellen

Hallo zusammen,

Excel soll schauen, ob in den Spalten 1-8 etwas drin steht, egal ob Zahlen Buchstaben etc.
Wenn ja, sollen die Zeilen A-J in ein anderes Datenblatt kopiert werden.

Beispiel:

Ist in Januar 1-4 irgendwo Text oder Zahlen enthalten --> Zelle G3 ist Text enthalten, dann kopiere die Zellen A3-J3 in Tabellenblatt2 in die Tabelle2 und das mit jeder Zeile in dieser Tabelle. Wenn die Zellen im Bereich Januar und Februar leer sind, soll nichts passieren.

Ist in Februar 5-8 irgendwo Text oder Zahlen enthalten --> Zelle L6 ist Text enthalten, dann kopiere die Zellen A6-J6 in Tabellenblatt3 in die Tabelle3 usw.

Könnt ihr mir weiterhelfen, wie ich das am einfachsten realisieren kann?
Ich habe die Excel-Datei mal mit angehangen, für ein vielleicht besseres Verständnis.
https://www.herber.de/bbs/user/162406.xlsx

Viele Grüße Marcus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub extact() For Z = 3 To ActiveSheet.UsedRange.Rows.Count 'Jede Zeile 1x behandeln Set Rng = Range(Cells(Z, "G"), Cells(Z, "J")) 'Januar If WorksheetFunction.CountA(Rng) > 0 Then 'wenn Eintrag dann kopieren With Sheets("Tabelle2") 'Tabellenblatt wählen lz = .Cells(Rows.Count, "A").End(xlUp).Row Range("A" & Z & ":J" & Z).Copy .Range("A" & lz + 1) 'kopieren / einfügen End With End If Set Rng = Range(Cells(Z, "K"), Cells(Z, "N")) 'Februar If WorksheetFunction.CountA(Rng) > 0 Then 'wenn Eintrag dann kopieren With Sheets("Tabelle3") 'Tabellenblatt wählen lz = .Cells(Rows.Count, "A").End(xlUp).Row Range("A" & Z & ":J" & Z).Copy .Range("A" & lz + 1) 'kopieren / einfügen (Schreibfehler in der Beschreibung? Ist gleich oben!) End With End If Next Z End Sub

Hi!

Ich hab dir geschrieben, ob das möglicherweise ein Schreibfehler in deiner Anforderung ist:
Es wird immer nur A:J kopiert, egal welcher Monat. Möglicherweise hättest du lieber die Angaben zum Monat dazu:

Sub extact()

    

    

    For Z = 3 To ActiveSheet.UsedRange.Rows.Count 'Jede Zeile 1x behandeln

    

        Set Rng = Range(Cells(Z, "G"), Cells(Z, "J")) 'Januar

    

        If WorksheetFunction.CountA(Rng) > 0 Then 'wenn Eintrag dann kopieren

            With Sheets("Tabelle2") 'Tabellenblatt wählen

                lz = .Cells(Rows.Count, "A").End(xlUp).Row

                Range("A" & Z & ":J" & Z).Copy .Range("A" & lz + 1) 'kopieren / einfügen

            End With

        End If

        

        Set Rng = Range(Cells(Z, "K"), Cells(Z, "N")) 'Februar

    

        If WorksheetFunction.CountA(Rng) > 0 Then 'wenn Eintrag dann kopieren

            With Sheets("Tabelle3") 'Tabellenblatt wählen

                lz = .Cells(Rows.Count, "A").End(xlUp).Row

                Range("A" & Z & ":F" & Z).Copy .Range("A" & lz + 1)

                Range("K" & Z & ":N" & Z).Copy .Range("G" & lz + 1)

            End With

        End If

    Next Z

End Sub

Gruß, MCO

Beliebteste Forumthreads (12 Monate)

Wenn Zellen Werte enthalten, dann kopiere andere Zellen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

390 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wenn Zellen Werte enthalten, dann kopiere andere Zellen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

390 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread