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