Täglicher Datensatz kopieren

Guten Morgen liebes Forum,
In meinem Code den ich im Forum gefunden habe, markiert es mir immer den "heutigen" Tag. Jedoch leider nur die eine Zelle in der das Datum steht. Nun suche ich nach einer Lösung die mir am jeweils "heutigen" Tag den ganzen Tagesbereich markiert resp. kopiert.
Die Daten stehen in der Zeile 8
Der Bereich sollte sich bis zur Zeile 41 erweitern, jeweils am "heutigen Tag"
Also z.b. ist heute der 15. dann sollte es mir den Bereich Q9:Q41 kopieren.
Hier einmal mein Code:

Sub Makro1()
Dim var, rng As Range
Set rng = Worksheets("Blatt 1").Range("C8:AG8")
var = Application.Match(CDbl(Date + 2), rng, 0)
If Not IsError(var) Then
Set rng = Worksheets("Blatt 1").Cells(9, var)
With rng.Select
End With
End If
'Range("I23").Select
'ActiveSheet.Paste
End Sub

Weiss jemand wie das geht?
Ich würde mich auf eine Antwort sehr freuen
Ganz liebe Grüsse
Manuela

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Dim var, rng As Range Set rng = Worksheets("Blatt 1").Range("C8:AG8") var = Application.Match(CDbl(Date), rng, 0) If Not IsError(var) Then Set rng = Worksheets("Blatt 1").Cells(9, var) rng.Resize(33, 1).Copy 'wohin? End If 'Range("I23").Select 'ActiveSheet.Paste

Hallo Hajo_Zi,
Wow, super schnelle Antwort :-))
ja stimmt, Mein Code markiert mir den heutigen Tag mit rng.select .Habs probiert mit rng.copy und das funktioniert. Da komme ich schon weiter.
Aber ich habe in der Zeile 8 die Daten und ab Zeile 9 bis Zeile 41 unten an der "Datumsleiste".
einige eintragungen die ich auf einem anderen Blatt jeweils täglich brauche.
Es ist eine Anwesenheitsliste. Auf der linken Seite stehen die Namen von Zeile A9 - B41. in der Zeile 8 steht das Datum und im Raster habe ich "X" wenn jemand anwesend ist. Darum möchte ich gerne den jeweils heutigen Tag Selektieren oder dann später auch kopieren und diese Daten in ein anderes Blatt übernehmen.
So habe ich die Tageskontrolle für mich.
LG Manuela

Dim var, rng As Range Set rng = Worksheets("Blatt 1").Range("C8:AG8") var = Application.Match(CDbl(Date), rng, 1) If Not IsError(var) Then Worksheets("Blatt 1").Cells(9, var + 2).Resize(33, 2).Copy Worksheets("Blatt 2").Cells(2, _ 3) End If

Sub Tag_vorbereiten2() Dim ze&, sp%, zei For ze = 50 To 82 For sp = 3 To 5 For zei = 9 To 41 'Namen einfügen If Sheets("Blatt 2").Cells(ze, sp).Interior.ColorIndex = 6 Then _ Sheets("Blatt 2").Cells(ze, 1) = Sheets("Blatt 1").Cells(zei, 1) Next zei Next sp Next ze End Sub

Sub Tag_vorbereiten2() Dim ze&, sp% For ze = 50 To 82 For sp = 3 To 5 'Namen einfügen If Sheets("Blatt 2").Cells(ze, sp).Interior.ColorIndex = 6 Then _ Sheets("Blatt 2").Cells(ze, 1) = Sheets("Blatt 1").Cells(ze - 41, 1) Next sp Next ze End Sub

Beliebteste Forumthreads (12 Monate)

	E	F	G	H	I
8	14.03.2013		15.03.2013		16.03.2013
9			a	yyyyyy
10			a

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread