Option
Explicit
Private
Sub
Workbook_SheetChange(
ByVal
Sh
As
Object
,
ByVal
Target
As
Range)
If
Left$(Sh.Name, 2) =
"MA"
Then
If
Target.Cells.Count > 1
Then
Set
Target = Target.Cells(1)
End
If
If
Target.Column = 2
Then
If
Target.Row >= 2
Then
Dim
rngResult
As
Excel.Range
Dim
strID
As
String
Dim
strBuddy
As
String
Dim
strThema
As
String
strID = Target.Offset(0, -1).Value
strThema = Target.Value
strBuddy = Target.Offset(0, 1).Value
If
strBuddy <>
""
And
strID <>
""
Then
On
Error
Resume
Next
Set
rngResult = Worksheets(strBuddy).Columns(
"A"
).Find( _
What:=strID, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
MatchCase:=
False
)
On
Error
GoTo
0
If
Not
rngResult
Is
Nothing
Then
Application.EnableEvents =
False
rngResult.Offset(0, 1).Value = strThema
Application.EnableEvents =
True
Call
MsgBox(
"Themen-Bezeichnung wurde erfolgreich bei Buddy '"
& strBuddy &
"' aktualisiert."
, _
vbInformation, _
"WOhOoo~!"
)
Else
Call
MsgBox(
"Die Umbenennung des Themas konnte nicht auf den Buddy übertragen werden."
, _
vbExclamation, _
"Achtung!"
)
End
If
End
If
End
If
End
If
End
If
End
Sub