Suchen und kopieren in die aktuelle Tabelle
edie
wie kann ich die nach aktivem Arbeitsblatt liegenden Tabellen nach einem Wert durchsuchen lassen. Wenn der Wert gefunden ist, soll ein Bereich markiert bzw. kopiert, in das aktuelle Arbeitsblatt ("Tabelle1"), werden.
Beim nachfolgende Makro wird der gesuchte Wert nicht markiert durch: "rBereich.Select" da stoppt das Makro.
Die Fehlermeldung: " Die Select-Methode des Range-Objektes konnte nicht ausgeführt werden"
Warum nur?
Sub Test()
Dim wksZiel As Worksheet
Dim iZähler As Integer
Dim rBereich As Range
Dim bln As Boolean
Dim vBox As Variant
vBox = Application.InputBox( _
prompt:="Geben Sie bitte den Wert ein:", _
Title:="Bereich kopieren", _
Default:="100", _
Left:=263, _
Top:=169, _
Type:=2)
If vBox = False Then Exit Sub
Set wksZiel = ThisWorkbook.Worksheets("Tabelle1")
For iZähler = 3 To Worksheets.Count
Set rBereich = Worksheets(iZähler).Rows("3:3").Find( _
what:=vBox, lookat:=xlWhole, LookIn:=xlValues)
If rBereich Is Nothing Then
bln = True
rBereich.Select
rBereich.Offset(2, 0).Select
Range(ActiveCell, Cells(Range(ActiveCell.Address).End(xlDown).Row + 2, ActiveCell.Column)).Copy
wksZiel.Range("K6").PasteSpecial
End If
Next iZähler
If bln = False Then
MsgBox "Wert wurde nicht gefunden!"
End If
End Sub
Grüße-edei
Anzeige