Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1808to1812
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

Datum suchen und kopieren

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
Anzeige
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
Anzeige
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
Anzeige
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

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige