AW: VBA: Zeile durchsuchen und Werte ausgeben
27.06.2017 08:49:35
Hajo_Zi
mal in der gleichen Art geantwortet wie der Beitrag ist.
Option Explicit
Public Sub Find_Methode()
Dim WkSh_1 As Worksheet
Dim WkSh_2 As Worksheet
Dim lZeile As Long
Dim rZelle As Range
Dim sFundst As String
Dim sSuchbegriff As String
sSuchbegriff = "j"
If sSuchbegriff "" Then
Application.ScreenUpdating = False
Application.EnableEvents = False
'Set WkSh_1 = ThisWorkbook.Worksheets("Sicherung_Telefonliste")
Set WkSh_2 = ThisWorkbook.Worksheets("Telefonliste")
With WkSh_2.Columns(1)
'Set Rafound1 = Columns(1).Find("Erledigt", Range("A" & Rows.Count), xlFormulas, _
' xlWhole, , xlNext)
Set rZelle = .Find(sSuchbegriff, .Count, xlFormulas, xlWhole, xlValues)
If Not rZelle Is Nothing Then
sFundst = rZelle.Address
Do
' deine Aktionen mit rZelle.Offset(0,1)
' lZeile = WkSh_1.Cells(Rows.Count, 1).End(xlUp).Row + 1
' WkSh_2.Range("A" & rZelle.Row & ":H" & rZelle.Row).Copy
' WkSh_1.Range("A" & lZeile & ":H" & lZeile).PasteSpecial Paste:=xlValues
' WkSh_2.Range("A" & rZelle.Row & ":H" & rZelle.Row).Delete Shift:=xlUp
Set rZelle = .FindNext(rZelle)
Loop While Not rZelle Is Nothing And rZelle.Address sFundst
End If
End With
Application.EnableEvents = True
Application.CutCopyMode = False 'Zwischenspeicher löschen
Application.ScreenUpdating = True
Set WkSh_1 = Nothing
'Set WkSh_2 = Nothing
Set rZelle = Nothing
End If
End Sub