Erweitern um Start = CDate(Int(Von)) / (Bis)
27.06.2013 00:34:26
Tom
habe hier ein für mich unlösbares Problem da ich nicht weiß wie ich dieses ansich schon perfekte Suchmakro um einen essentiel gewinnbringenden Punkt erweitere bzw. abändere.
Dieser Code macht was er soll. Er sucht mir was ich eingebe und kopiert alle Zeilen in dem der Begriff gefunden wurde in ein anderes Blatt. Perfekt.
Wie kann hier umgeschrieben oder integriert werden dass er (erst/oder) folgendes sucht und die Zeilen in ein anderes Blatt kopiert?
Start = CDate(Int(Von))
Ende = CDate(Int(Bis))
In Spalte "K"
Es soll vorher also eine erste Routine für den Datumsberich erfolgen und dann der zu suchende Begriff eingegeben werden.
Hoffe da draußen kann mir jemand helfen.
Vielen Dank schon einmal im Voraus.
Sub Searcheverything()
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Dim lngLetzte As Long
Dim rng As Range, rngSource As Range, rngStart As Range
Dim varInput As Variant
Dim iRow As Integer
varInput = Application.InputBox( _
prompt:="Geben Sie bitte den Suchbegriff ein:", _
Title:="Suchbegriff", _
Default:="", _
Left:=263, _
Top:=169, _
Type:=2)
If varInput = False Then Exit Sub
If varInput = "" Then Exit Sub
Sheets("Quelldatei").Select
Set rng = ActiveSheet.Columns("A:X").Find( _
what:=varInput, lookat:=xlWhole, LookIn:=xlValues)
If rng Is Nothing Then
Beep
MsgBox "Suchbegriff nicht gefunden!"
Exit Sub
End If
Set rngStart = rng
Set rngSource = rng.EntireRow
Do
Set rng = Cells.FindNext(after:=rng)
If rng.Address = rngStart.Address Then Exit Do
Set rngSource = Application.Union(rngSource, rng.EntireRow)
Loop
With Worksheets("Suche")
iRow = .Cells(Rows.Count, 1).End(xlUp).Row
If iRow = 1 Then iRow = 2 Else iRow = iRow + 1
rngSource.Copy .Cells(iRow, 1)
.Columns.AutoFit
End With
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
End Sub