Zelle mit Datum und Zeit suchen und Kopieren

Hallo zusammen,
ich bin auf der Suche nach einem Makro welches in Tabelle1 in der Spalte A ab Zeile 7 nach einer Zelle mit Datum und Zeit z.B. 15.12.2015 23:45:00 sucht und dann die gefundene Zelle mit der Zelle in Spalte C gleiche Zeile kopiert. Den Kopierinhalt auf Tabelle2 in Spalte A in die erste freie Zeile wieder einfügt. Dann der nächste Tag mit gleicher Zeit usw.. Tabelle1 Spalte A ist mit viertelstunden Schritten gefüllt, Spalte B mit viertelstunden Werten und in Spalte C wird eben um die gesuchte Zeit ein Tagesmittelwert gebildet. Der Zeitraum in Tabelle1 Spalte A geht über ein halbes Jahr und kann variieren. Wie muss eine solche Schleife aussehen? Mit Zeilen zählen oder einem Step von 96 Viertelstunden komme ich nicht zurecht. Durch die Sommer- Winterzeitumstellung ändert sich das ja immer wieder.
Tabelle1 ist wie folgt
In Zelle A7 steht z.B. 15.12.2015 23:30:00
In Zelle A8 steht z.B. 15.12.2015 23:45:00
usw.
In Zelle B7 steht ein 1/4stunden-Wert
In Zelle B8 steht ein 1/4stunden-Wert
usw.
In Spalte C wird immer um 23:45:00 ein Tagesmittelwert gebildet

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Thomas,
dann diesen Code.

' **********************************************************************
' Modul: Modul2  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub copyValues()
Dim rng As Range, rngC As Range
Dim strFirst As String

With Sheets("Suchen&Kopieren")
  With .Range("A:A")
    Set rng = .Find(What:="* 23:45:00", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, _
      SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If Not rng Is Nothing Then
      strFirst = rng.Address
      Do
        If rngC Is Nothing Then
          Set rngC = Union(rng, rng.Offset(0, 2))
        Else
          Set rngC = Union(rngC, Union(rng, rng.Offset(0, 2)))
        End If
        Set rng = .FindNext(rng)
      Loop While Not rng Is Nothing And strFirst <> rng.Address
    End If
  End With
End With

If Not rngC Is Nothing Then
  With Sheets("Ziel")
    rngC.Copy .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1)
  End With
End If

Set rng = Nothing
Set rngC = Nothing
End Sub

So sieht bei mir das Ergebnis des Codes in deiner Beispieldatei aus.
Ziel

	A	B	C
1
2	13.12.2015 23:45:00	TM-Wert
3	14.12.2015 23:45:00	TM-Wert
4	13.12.2015 23:45:00	Test96
5	14.12.2015 23:45:00	Test192
6	15.12.2015 23:45:00	Test288
7	16.12.2015 23:45:00	Test384
8	17.12.2015 23:45:00	Test480
9	18.12.2015 23:45:00	Test576
10

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Zelle mit Datum und Zeit suchen und Kopieren

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

327 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zelle mit Datum und Zeit suchen und Kopieren

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

327 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread