AW: Namen in Splate suchen und Zeile kopieren
26.10.2018 16:54:30
Werner
Hallo Martin,
ein paar wenig Infos.
Wo stehen deine Daten in Tabelle1 (von Zeile/Spalte bis Zeile/Spalte)?
Wohin soll kopiert werden (Zielzelle A1)?
Hier mal ein Code. Dabei bin ich davon ausgegangen, dass im Quellblatt die eigentlichen Daten in Zeile 2 beginnen und in Zeile 1 Überschriften vorhanden sind. Zudem bin ich davon ausgegangen, dass du auch Daten in Spalte A hast.
Die Daten werden ins Zielblatt (wird neu erstellt) ab A1 eingefügt.
Public Sub Suchen_kopieren()
Dim loZeile As Long, loSpalte As Long
Dim strSuchbegriff As String, wsBlatt As Worksheet
Application.ScreenUpdating = False
strSuchbegriff = InputBox("Name eingeben:", "Suche nach...")
If Not strSuchbegriff = vbNullString Then
With Worksheets("Tabelle1") 'Blattname anpassen
If WorksheetFunction.CountIf(.Columns(2), strSuchbegriff) = 0 Then
MsgBox strSuchbegriff & " ist in Spalte B nicht enthalten."
Exit Sub
End If
On Error Resume Next
Set wsBlatt = Worksheets(strSuchbegriff)
If Err.Number = 9 Then
On Error GoTo 0
Worksheets.Add , Sheets(Sheets.Count)
ActiveSheet.Name = strSuchbegriff
End If
loZeile = .Cells(.Rows.Count, 2).End(xlUp).Row
loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(1, 1), .Cells(loZeile, loSpalte)).AutoFilter Field:=2, _
Criteria1:=strSuchbegriff
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible).Copy _
Worksheets(strSuchbegriff).Range("A1")
.AutoFilterMode = False
.Activate
End With
End If
End Sub
Gruß Werner