Suchmakro funktioniert kann aber zu viel
03.01.2007 17:01:40
michael
und bringt ein lächeln mit und gute Laune
dann hofft der michael der kleine
das man ihm helfe ,denn er schafft es nicht alleine.
Ich habe ein Suchmakro das funktioniert aber es kann zu viel
Es kopiert ALLES sollte aber nur die WERTE kopieren.
könnt ihr mir bitte helfen.
Danke michael.
Sub Suchen1()
Dim Suchtext As String
Dim Zelle As Range
Dim i As Long
Dim j As Integer
Dim KopierteZeilen()
Dim NeueMappe As Worksheet
Dim Arbeitsmappe As String
Dim Schon_da As Boolean
Suchtext = InputBox(" " & Chr(10) & " " & Chr(10) & "Wonach suchen wir ?", " der kleine michael", "Eingabe")
If Suchtext <> "" Then
Arbeitsmappe = ActiveWorkbook.Name
Workbooks.Add
Set NeueMappe = ActiveWorkbook.ActiveSheet
i = 2
Sheets("Tabelle1").Select
Sheets("Tabelle1").Name = "Suchergebniss"
Workbooks(Arbeitsmappe).Activate
Rows("1:1").Copy NeueMappe.Cells(1, 1)
For Each Zelle In Workbooks(Arbeitsmappe).ActiveSheet.UsedRange
If InStr(1, Zelle.Value, Suchtext, vbTextCompare) > 0 Then
ReDim Preserve KopierteZeilen(i - 2)
Schon_da = False
For j = 0 To UBound(KopierteZeilen)
If KopierteZeilen(j) = Zelle.Row Then Schon_da = True
Next
If Not Schon_da Then
Rows(Zelle.Row & ":" & Zelle.Row).Copy NeueMappe.Cells(i, 1)
i = i + 1
End If
End If
Next
NeueMappe.Activate
Columns("A:H").EntireColumn.AutoFit
Range("A1").Select
End If
End Sub