Zeiten aus mehreren Arbeitsblättern entnehmen und Weiteres

Hallo Claus,

ich möchte das ganze jetzt noch ein bisschen anpassen:

und zwar haben ich einen Bereich markiert und möchte jetzt, dass wie in dem anderen code mein Wert aus A1 in dem ausgewählten Bereich in dem Arbeitsblatt aus B1 markiert wird.

Mein Bereich wird momentan so ausgewählt:

Sub Test()

ActiveSheet.PivotTables("Pivottable_Name").PivotSelect "", xlDataAndLabel, True

End Sub

Wenn du mir noch helfen kannst anstatt activsheet das Arbeisblatt aus B2 und als Pivottables("Den_Wert_aus_C1") einzufügen wäre das grandios!!

Grüße LiNy

Hallo,

Leider steht da Suchwert nich gefunden, obwohl alles da ist.

Kann es sein das der Suchbereich nicht richtig eingegrentzt wird, bwz. nicht selected wird?

So sieht es aus

Tabelle1:





FUN:





Grüße LINY

Hallo,

dann probiere es so:

Sub Suche()
Dim wsh As Worksheet
Dim sWert As Double 'Hier den Wert korrekt deklarieren
Dim c As Range
Dim Firstaddress As String

With Sheets("Tabelle1")
Set wsh = Sheets(.Range("B1").Value)
sWert = .Range("A1")
End With

With wsh
Set c = .UsedRange.Find(sWert)
If Not c Is Nothing Then
Firstaddress = c.Address
Do
c.Interior.Color = vbRed
Set c = .UsedRange.FindNext(c)
Loop While c.Address <> Firstaddress
Else
MsgBox "Suchwert nicht gefunden"
End If
End With
End Sub

Claus

Hallo Claus,

Vielen Dank für die Hilfe, aber ja ich brauche jeden übereinstimmenden Wert auf dem Blatt markiert.

vielen Dank

LiNy

Hallo,

es wäre besser, wenn du den Suchbereich im Tabellenblatt einschränken würdest.

Hier nun den Code zum Suchen im gesamten Bereich. Falls der Wert mehrfach vorkommen kann und auch mehrfach markiert werden soll, musst du das hier posten oder selbst anpassen:

Sub Suche()
Dim wsh As Worksheet
Dim sWert As Double 'Hier den Wert korrekt deklarieren
Dim c As Range

With Sheets("Tabelle1")
Set wsh = Sheets(.Range("B1").Value)
sWert = .Range("A1")
End With

With wsh
Set c = .UsedRange.Find(sWert)
If Not c Is Nothing Then
c.Interior.Color = vbRed
Else
MsgBox "Suchwert nicht gefunden"
End If
End With
End Sub

Claus