Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeile kopieren wenn bestimmter Wert in Zelle

Zeile kopieren wenn bestimmter Wert in Zelle
10.07.2018 16:49:24
Tobias
Hallo Zusammen,
ich hoffe Ihr könnt mir helfen.
Ich möchte in der Spalte "H" in der Tabelle "Quelle" nach einem Wert suchen. In diesem Fall hat die Spalte unterschiedliche Datumswerte (TT.MM.JJJJ) und ich möchte z.B. alle Werte mit ".06.2018". Den Wert ".06.2018" wählt man in einem anderen Sheet("Startseite") aus. Ist ein Wert gefunden, soll die entsprechende ganze Zeile kopiert und in der Tabelle "Ziel" gespeichert werden.
Sub DatenAufbereiten()
Datum = Sheets("Startseite").Range("G2").Value
Sheets("Quelle").Select
Dim zelle As Range, zeile As Long
For Each zelle In Range("H:H")
If InStr(1, zelle, Datum) Then
Sheets("Quelle").Rows(zeile).Copy
Sheets("Ziel").Select
Sheets("Ziel").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next
End Sub

Irgendwie funktioniert das ganze nicht so? Bitte um eure Hilfe. Danke

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Autofilter
10.07.2018 17:17:19
Fennek
Hallo,
die Auswahl aller Zeilen im Juni 2018:

with cells(1).currentregion
.autofilter 1, 26, 11
'oder
.autofilter 1, array(1, "4/26/2016")
end with
mfg
(aus dem Archiv, ungetestet)
AW: Autofilter
10.07.2018 23:49:04
Tobias
Hallo Zusammen,
Problem gelöst
Sub DatenAufbereiten()
Dim x As Long
Dim y As Long
y = 2
ThisWorkbook.Worksheets.Add.Name = "TempSheet"
lastrow = Sheets("Quelle").Cells(Rows.Count, 1).End(xlUp).Row
Datum = Sheets("Startseite").Range("D2").Value
For x = 2 To lastrow
If InStr(1, Sheets("Quelle").Cells(x, 8), Datum) Then
Sheets("Quelle").Rows(x).copy Destination:=Sheets("TempSheet").Rows(y)
y = y + 1
Else
End If
Next x
Sheets("TempSheet").Select
Range("A2:H2000").Select
Selection.copy
Sheets("Auswertung").Select
Range("A2").Select
ActiveSheet.Paste
Application.DisplayAlerts = False
Worksheets("TempSheet").Delete
Application.DisplayAlerts = True
End Sub

Anzeige
AW: Autofilter
10.07.2018 23:49:05
Tobias
Hallo Zusammen,
Problem gelöst
Sub DatenAufbereiten()
Dim x As Long
Dim y As Long
y = 2
ThisWorkbook.Worksheets.Add.Name = "TempSheet"
lastrow = Sheets("Quelle").Cells(Rows.Count, 1).End(xlUp).Row
Datum = Sheets("Startseite").Range("D2").Value
For x = 2 To lastrow
If InStr(1, Sheets("Quelle").Cells(x, 8), Datum) Then
Sheets("Quelle").Rows(x).copy Destination:=Sheets("TempSheet").Rows(y)
y = y + 1
Else
End If
Next x
Sheets("TempSheet").Select
Range("A2:H2000").Select
Selection.copy
Sheets("Auswertung").Select
Range("A2").Select
ActiveSheet.Paste
Application.DisplayAlerts = False
Worksheets("TempSheet").Delete
Application.DisplayAlerts = True
End Sub

Anzeige

341 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige