Ich möchte überall wo in der Spalte B der Wert AA vorkommt
(Beispiel: 14014291004AA AA EPAK=21523EBES=05217)
die ganze Zeile in eigenes Blatt kopieren.
Gäbe es hierfür bitte eine VBA Lösung?
Danke
Josef
Sub SearchNames()
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 Namen ein:", _
Title:="Namen-Zeilen kopieren", _
Default:="AA", _
Left:=263, _
Top:=169, _
Type:=2)
If varInput = False Then Exit Sub
Set rng = ActiveSheet.Columns("B1:B5000").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.Adress = rngStart.Address Then Exit Do
Set rngSource = Application.Union(rngSource, rng.EntireRow)
Loop
With Worksheets("Target")
iRow = .Cells(Rows.Count, 1).End(xlUp).Row
If iRow = 1 Then iRow = 2 Else iRow = iRow + 3
rngSource.Copy .Cells(iRow, 1)
.Columns.AutoFit
End With
End Sub
Sub AA_kopieren()
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="=*AA*", Operator:=xlAnd
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A17").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub