Finden und kopieren

Bild

Betrifft: Finden und kopieren
von: Herman
Geschrieben am: 28.07.2015 09:06:19

Hallo Excel- und VBA-Profis,
ich habe zwei Arbeitsblätter. Im "Blatt1" stehen alle Tage des jeweils aktuellen Monats untereinander, mit je 15 Zeilen Abanstand, alle in Spalte A, beginnend in Zeile 14.
Auf "Blatt2" stehen ebenfalls untereinander alle Tage der aktuellen Woche, Spalte A, beginnend in Zeile 32. Jeweils direkt unter dem Datum, stehen in den darunterfolgenden 15 Zeilen verschiedene Daten.
Folgendes soll realisiert werden:
Es soll geprüft werden, ob auf Blatt2 eine Datumsangabe steht (allerdings nur innerhalb eines bestimmten Bereichs), die sich ebenfalls auf Blatt1 befindet (ebenfalls nur innerhalb eines bestimmten Bereichs). Stimmen die Datumsangaben überein, sollen die Werte, die in den 15 Zeilen unter dem Datum auf Blatt2 stehen, direkt in die 15 Zeilen unter dem Datum auf Blatt1 kopiert werden.
Hat jemand eine Idee, wie ich das am besten realisieren kann?
Vielen Dank im Voraus!

Bild

Betrifft: AW: Finden und kopieren
von: Herman
Geschrieben am: 28.07.2015 11:59:49
habe es selbst gelöst - mit hoher wahrscheinlichkeit ist es nicht die beste Lösung, es funktioniert aber (jedenfalls bisher)

Sub cop_helper()
Dim zeile_h As Integer
Dim zeile_c As Integer
Dim l As Integer
zeile_h = 14
zeile_c = 32
For l = 14 To 470
If Sheets("Helper").Cells(zeile_h, 1).Value = Sheets("Blatt2").Cells(zeile_c, 1).Value Then
            Sheets("Blatt2").Activate
            Range("A" & zeile_c + 1 & ":I" & zeile_c + 14).Select
            Selection.Copy
            Sheets("Blatt1").Select
            Range("A" & zeile_h + 1).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Application.CutCopyMode = False
End If
If zeile_c = 122 Then
zeile_c = 32
zeile_h = zeile_h + 15
Else
zeile_c = zeile_c + 15
End If
If zeile_h > 464 Then
Exit Sub
End If
Next l
End Sub


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Finden und kopieren"