AW: Spalte auswerten und neue Tabelle anlegen
15.02.2018 14:26:03
chao.soft
Hey Geronimus,
wenn ich das richtig verstehe, dann hast du eine Tabelle mit ganz vielen Daten, wo in Spalte 6 immer ein Datum steht. Jetzt möchtest du diese Daten nach einem bestimmten Datum durchsuchen und alle gefundenen Ergebnisse in ein neues Tabellenblatt kopieren. Hab ich das so richtig verstanden?
Versuch es mal mit folgendem Code. Wahrscheinlich musst du die Adressen etwas anpassen, da ich nicht weiß wie genau deine Tabelle aufgebaut ist.
Sub KopiereNachDatum()
Dim strSuchbegriff As String
Dim lngTreffer As Long
strSuchbegriff = InputBox("Geben Sie einen Suchbegriff ein:", _
"Durchsucht Spalte Datum")
lngTreffer = Application.WorksheetFunction.CountIf(Columns(6), CDate(strSuchbegriff))
MsgBox lngTreffer & " mal " & strSuchbegriff, , ""
'NEU
If lngTreffer > 0 Then
If IsError(Evaluate(strSuchbegriff & "!A1")) Then
'Wenn Tabelle noch nicht vorhanden, dann erstellen
ThisWorkbook.Worksheets.Add.Name = strSuchbegriff
End If
Dim intLastRow, i, j As Long: j = 1
'letzte Zeile der Daten herausfinden
intLastRow = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row
'alle Zeilen der Daten durchlaufen
For i = 1 To intLastRow
'Wenn Datum mit Suchbegriff übereinstimmt...
If strSuchbegriff = Tabelle1.Cells(i, "F") Then
'...dann die Zeile in die (neue) Tabelle übernehmen
Tabelle1.Rows(i).EntireRow.Copy ThisWorkbook.Worksheets(strSuchbegriff).Rows(j)
j = j + 1
End If
Next
'(neue) Tabelle mit den gesuchten Daten anzeigen
ThisWorkbook.Worksheets(strSuchbegriff).Select
End If
End Sub
Beste Grüße
chaosoft