VBA Code - zum kopieren | HERBERS Excel Forum

Forumthread: VBA Code - zum kopieren

VBA Code - zum kopieren

18.02.2025 14:42:00

Jonny

Hallo zusammen,

ich habe folgenden Code, anhand eines Datum kopiere ich einen Gewissen Bereich in ein Worksheet "Übersicht".
Ich möchte jetzt folgenden Code umbauen. Er soll nicht mehr in B:B suchen sondern in Spalte E. Wenn dort eine 1 oder eine 2 eingetragen ist soll der untenstehende Bereich kopiert werden. Das Ganze soll aber erst ab E41 geprüft werden.

Kann mir jemand helfen?

LG Jonny

With Worksheets("Übersicht")

    

    Application.ScreenUpdating = False

    

    Worksheets("Wochenübersicht").Range("A35:AA1000").Clear 'Daten bereinigen in Wochenübersicht

    

    For sht = 2 To Sheets.Count - 2 'alle Sheets durchgehen bis auf die letzten beiden

        Set Rng = Sheets(sht).Range("B:B").SpecialCells(xlCellTypeConstants) 'nur gefüllte Zelle in B beachten

        

        For Each cl In Rng 'Zellen durchgehen

            If IsDate(cl) Then 'wenn Datum...

            lngErste = WorksheetFunction.Max(35, .Cells(.Rows.Count, "A").End(xlUp).Row + 1) 'wo anfangen

                Sheets(sht).Range("A" & cl.Row - 2 & ":Y" & cl.Row + 7).Copy 'Bereich festlegen

                .Cells(lngErste, "A").PasteSpecial  'Datensatz kopieren

            End If

            Next cl

        Next sht

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA Code - zum kopieren

18.02.2025 14:50:05

Lutz Fricke
AW: VBA Code - zum kopieren

18.02.2025 15:13:14

Yal
AW: VBA Code - zum kopieren

18.02.2025 15:59:44

Jonny
AW: VBA Code - zum kopieren

18.02.2025 16:07:07

Crazy Tom
AW: VBA Code - zum kopieren

18.02.2025 16:08:27

Yal
AW: VBA Code - zum kopieren

18.02.2025 15:24:01

GerdL
AW: VBA Code - zum kopieren

18.02.2025 15:52:04

Jonny
AW: VBA Code - zum kopieren

18.02.2025 15:03:16

Jonny
AW: VBA Code - zum kopieren

18.02.2025 15:28:22

Lutz Fricke

AW: VBA Code - zum kopieren

18.02.2025 14:50:05

Lutz Fricke

Oder weil deine Zelle als "Text" formatiert ist...

AW: VBA Code - zum kopieren

18.02.2025 15:13:14

Yal

Moin,

so etwa?

Sub Kopieren()

Dim sht As Long

Dim cl As Range

Dim Data

Dim Ziel As Range



    Application.ScreenUpdating = False

    Application.EnableEvents = False

    With Worksheets("Übersicht")

        .Range("A35:AA1000").Clear 'Daten bereinigen in Wochenübersicht

        For sht = 2 To Sheets.Count - 2 'alle Sheets durchgehen bis auf die letzten beiden

            Set Rng = Sheets(sht).Range("E41:E99999").SpecialCells(xlCellTypeConstants)

            For Each cl In Rng

                If cl.Value = 1 Or cl.Value = 2 Then

                    Set Ziel = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)

                    If Ziel.Row  35 Then Set Ziel = .Range("A35")

                    Data = cl.Offset(-2).EntireRow.Range("A:Y").Resize(10).Value

                    Ziel.Resize(UBound(Data, 1), UBound(Data, 2)) = Data

                End If

                Next cl

            Next sht

        Next

    End With

    Application.ScreenUpdating = True

    Application.EnableEvents = True

End Sub

VG
Yal

AW: VBA Code - zum kopieren

18.02.2025 15:59:44

Jonny

Bekomme beim letzten Next eine Fehlermeldung

AW: VBA Code - zum kopieren

18.02.2025 16:07:07

Crazy Tom

moin,

dann mach dat next einfach wech

mfg Tom

AW: VBA Code - zum kopieren

18.02.2025 16:08:27

Yal

Hallo Jonny,

ich habe nur dein krummen Code soweit es geht ergänzt und natürlich etwas dabei übersehen. Aber Du wirst es schnell finden. Nicht zur Strafe, sondern zur Übung.

Ein Tipp: die Anzahl "For" und "Next" sollten gleich sein.

VG
Yal

AW: VBA Code - zum kopieren

18.02.2025 15:24:01

GerdL

Moin Jonny!

Sub Unit()



    Dim sht As Integer, zeile As Long, zeileübersicht As Long

    

    

    Worksheets("Wochenübersicht").Range("A35:AA1000").Clear 'Daten bereinigen in Wochenübersicht

    

    zeileübersicht = Worksheets("Übersicht").Cells(Worksheets("Übersicht").Rows.Count, "A").End(xlUp).Row + 1

    If zeileübersicht  35 Then zeileübersicht = 35

    

    For sht = 2 To Sheets.Count - 2 'alle Sheets durchgehen bis auf die letzten beiden

    

        With Sheets(sht)

            For zeile = 41 To .Cells(.Rows.Count, "E").End(xlUp).Row

            

                If .Cells(zeile, "E") = 1 Or .Cells(zeile, "E") = 2 Then 'Bedingung

                    .Range(.Cells(zeile, "A"), .Cells(zeile, "Y")).Copy

                    Worksheets("Übersicht").Cells(zeileübersicht, "A").PasteSpecial 'Datensatz kopieren

                    Application.CutCopyMode = False

                End If

            

            Next zeile

        End With

    

    Next sht





End Sub

Gruß Gerd

AW: VBA Code - zum kopieren

18.02.2025 15:52:04

Jonny

Danke! Probiere ich mal aus. Ich möchte den Datensatz auch wieder an der selben Position einsetzten. Wie mache ich das?

AW: VBA Code - zum kopieren

18.02.2025 15:03:16

Jonny

Ne das ist es nicht. Passt auch leider nicht zu meiner Fragestellung.

AW: VBA Code - zum kopieren

18.02.2025 15:28:22

Lutz Fricke

Bin im Thread verrutscht.
Ließ sich leider nicht mehr löschen...

VBA Code - zum kopieren

Forumthread: VBA Code - zum kopieren

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread