Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1436to1440
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Finden und kopieren

Finden und kopieren
28.07.2015 09:06:19
Herman
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!

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Finden und kopieren
28.07.2015 11:59:49
Herman
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

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige