ganze Zeile kopieren, wenn Bedingung erfüllt ist

Forumthread: ganze Zeile kopieren, wenn Bedingung erfüllt ist

24.11.2024 21:21:28

mellylicht1971

Hallo zusammen,

ich bin mir sehr sicher, dass es hierzu schon Beiträge gibt und ich hab auch viele gelesen, aber da ich mit VBA blutiger Anfänger bin, konnte ich keinen auf mein Problem anpassen.
Wahrscheinlich ist es ganz einfach:
Die Mitarbeitenden erfassen ihre Zeiten digital, manchmal gibt es Fehlbuchungen und Zeitkorrekturen, so dass zu einem Datum bis zu 3 Buchungen erfolgen können.
Ich habe hier die Arbeitsmappe hochgeladen:
https://www.herber.de/bbs/user/173798.xlsx

Aus der Mappe "Berechnungen" sollen automatisch die ganzen Zeilen einer Buchung in die Mappe "Sortiert" kopiert werden jeweils zum richtigen Datum also alle Buchungen des 01.11.2024 unter 1, alle Buchungen des 02.11.2024 unter 2 usw., wo sie dann untereinander geordnet sind und weiterverarbeitet werden können. Manchmal gibt es halt nur eine Buchung zu einem Datum manchmal mehr.
Mit der Bitte um Hilfe,

Melanie

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: ganze Zeile kopieren, wenn Bedingung erfüllt ist

25.11.2024 09:40:22

MCO

AW: ganze Zeile kopieren, wenn Bedingung erfüllt ist

25.11.2024 09:40:22

MCO

Moin, Melanie!

Ich hoffe, ich hab es richtige verstanden:
Werte sollen kopiert werden, nicht einfach die Formeln?

Mit Kommentaren erklärt, sieht es dann so aus, schau mal ob es funktioniert.

Sub zeilenweise_übertragen()



    Dim z As Long

    Dim cpy_rng As Range

    Dim einfüg_z As Range

    Dim Ber_sh As Worksheet

    

    Application.ScreenUpdating = False 'Bildschirmflackern abstellen

    

    Set Ber_sh = Sheets("Berechnungen")

    With Ber_sh

        .Select

        z = .Range("C" & Rows.Count).End(xlUp).Row

        

        For i = 5 To z

            If .Range("C" & i) = "" Then Exit For 'kein Wochentag? Ausstieg aus Schleife

            Set cpy_rng = .Range("A" & i & ":Y" & i) 'Bereich zum kopieren festlegen

            Set einfüg_z = Sheets("sortiert").Range("A:A").Find(what:=Range("A" & i), lookat:=xlWhole) 'Zeile suchen

            

            If Not einfüg_z Is Nothing Then

                Do While einfüg_z.Offset(0, 1) > "" 'gefüllte Zeilen übergehen

                    Set einfüg_z = einfüg_z.Offset(1, 0)

                Loop

                

                cpy_rng.Copy                            'kopieren

                einfüg_z.PasteSpecial (xlValues)        'Werte übernehmen

                einfüg_z.PasteSpecial (xlPasteFormats) 'Formate übernehmen

            Else

                MsgBox "Tag " & .Range("A" & i) & " nicht gefunden", vbInformation + vbOKOnly

            End If

        Next i

    End With

End Sub

Gruß, MCO

ganze Zeile kopieren, wenn Bedingung erfüllt ist

Forumthread: ganze Zeile kopieren, wenn Bedingung erfüllt ist

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread