Datum suchen und kopieren

Forumthread: Datum suchen und kopieren

29.01.2021 08:45:01

Andre

Hallo Zusammen
Ich habe mal wieder ein Problem und zwar möchte ich in meiner Tabelle1 in Spalte N das aktuelle Datum suchen wenn er das aktuelle Datum gefunden hat soll er alle gefundenen Zeilen von Spalte B bis P kopieren und in Tabelle 2 in letzten beschriebenen Zeile in Spalte B ohne Formel wieder einfügen.
Ich habe eine Testdatei hochgeladen.
Vielen Dank im voraus für eure Hilfe
https://www.herber.de/bbs/user/143397.xlsx

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Datum suchen und kopieren

29.01.2021 09:05:25

Klaus
AW: Datum suchen und kopieren

29.01.2021 09:14:03

Werner
besser als meine Lösung

29.01.2021 09:24:06

Klaus
AW: besser als meine Lösung

29.01.2021 09:37:20

Andre
Gerne u. Danke für die Rückmeldung. o.w.T.

29.01.2021 09:45:33

Werner

AW: Datum suchen und kopieren

29.01.2021 09:05:25

Klaus

Hallo Andre,
dieses Makro macht was du möchtest - WENN du die bescheuerten "verbundenen Zellen" in Tabelle2!B10:B11 entfernst! Sobald der erste Datensatz drin steht wird die letzte Zeile auch mit verbundnenen Zellen in der Überschrift gefunden.

Option Explicit
Sub CopyHeute()
Dim z    As Long
Dim lRow As Long
Dim iRow As Long
With Tabelle2
iRow = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
With Tabelle1
lRow = .Cells(.Rows.Count, 14).End(xlUp).Row
For z = 12 To lRow
If .Cells(z, 14).Value = Date Then
iRow = iRow + 1
.Range(.Cells(z, 2), .Cells(z, 16)).Copy
Tabelle2.Range("B" & iRow).PasteSpecial xlPasteValues
End If
Next z
End With

LG,
Klaus

AW: Datum suchen und kopieren

29.01.2021 09:14:03

Werner

Hallo,
schließe mich bezüglich den verbundenen Zellen den Äußerungen meines Vorredners an.
Mein Code, via Autofilter, funktioniert aber auch mit den bescheuerten verbundenen Zellen.
Einzige Voraussetzung: Du mußt auf Tabellenblatt 1 zwichen Zeile 11 und 12 zwei Zeilen einfügen und anschließend ausblenden.

Sub Makro1()
Dim loLetzte As Long
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
If WorksheetFunction.CountIf(.Columns("N"), Date) > 0 Then
.Range("$B$13:$P$" & .Cells(.Rows.Count, "N").End(xlUp).Row).AutoFilter Field:=13, _
Criteria1:=xlFilterToday, Operator:=xlFilterDynamic
With .AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Copy
With Worksheets("Tabelle2")
loLetzte = .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Row
If .Cells(12, "B") = "" Then loLetzte = 12
.Cells(loLetzte, "B").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With
End With
If .AutoFilterMode Then .Range("B13").AutoFilter
End If
End With
End Sub

Gruß Werner

besser als meine Lösung

29.01.2021 09:24:06

Klaus

Hallo Andre,
Werners Lösung ist besser, da sie auch sehr große Datenmengen in kurzer Zeit verarbeitet: Das ist der Vorteil, wenn keine Schleifen vorkommen.
Im Level "Bescheiden" würde ich erstmal die Schleifenlösung optimieren, aber schau dir auf jedem Fall auch die Filterlösung an.
LG,
Klaus

AW: besser als meine Lösung

29.01.2021 09:37:20

Andre

Erstmal vielen Dank Klaus und Werner für eure schnellen Antworten.
Ich habe den Code von Werner genommen das ist genau was ich gesucht habe:)
Vielen Dank nochmal Euch beiden und bleibt vor allem Gesund

Gerne u. Danke für die Rückmeldung. o.w.T.

29.01.2021 09:45:33

Werner

Beliebteste Forumthreads (12 Monate)

Forumthread: Datum suchen und kopieren

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread