Excel VBA - Werte aus Zelle auflisten

Sub AddUsedValuesToOverview()
    ' Variablen  
    Dim ws As Worksheet, cell As Range, value As String, category As String, val As Variant, wsOverview As Worksheet, catRange As Range
    ' Übersichtssheet festlegen  
    Set wsOverview = Sheets("Übersicht")  
    For Each ws In Worksheets
        If Left(ws.Name, 2) = "KW" Then  
            For Each cell In ws.Range(ws.Range("C1"), ws.Cells(Rows.Count, "C").End(xlUp))  
                ' Wert der Eingetragen wird  
                value = cell.value
                ' Kategorie der Eintragung  
                category = cell.Offset(0, -1).value
                If category <> "" And value <> "" Then  
                    ' Durchlaufe Array-Werte (getrennt anhand von Kommas oder Semikolons)  
                    For Each val In Split(Replace(value, ";", ",", 1, -1, 1), ",", -1, 1)  
                        With wsOverview
                            ' find die passende Kategoriespalte im benannten Bereich "Kategorien" in der Übersicht  
                            Set catRange = .Range("Kategorien").Find(category, LookIn:=xlValues, LookAt:=xlWhole)  
                            ' wenn es die Kategorie gibt  
                            If Not catRange Is Nothing Then
                                ' Suche den eingetragenen Wert in der Kategorie-Spalte  
                                If catRange.EntireColumn.Find(Trim(val), LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
                                    ' Wert ist noch nicht vorhanden, also hänge ihn ans Ende der Kategorie in der Übersicht  
                                    .Cells(Rows.Count, catRange.Column).End(xlUp).Offset(1, 0).value = Trim(val)
                                End If
                            End If
                        End With
                    Next
                End If
            Next
        End If
    Next
End Sub

' Durchlaufe Array-Werte (getrennt anhand von Kommas oder Semikolons)  
For Each val In Split(Replace(value, ";", ",", 1, -1, 1), ",", -1, 1)  

Public lastValue As Variant

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    ' Variablen definieren  
    Dim value As String, category As String, val As Variant, wsOverview As Worksheet, catRange As Range, regex As Object
    ' Wenn Sheet ein KW Sheet ist und eine Änderung in Spalte C vorgenommen wird  
    If Left(Sh.Name, 2) = "KW" And Not Intersect(Target, Sh.Range("C:C")) Is Nothing Then  
        ' Übersichtssheet festlegen  
        Set wsOverview = Sheets("Übersicht")  
        ' Wert der eingetragen wird  
        value = Replace(Mid(Target.Cells(1).value, Len(lastValue) + 1), " ", "", 1, -1, 1)  
        ' Kategorie der Eintragung  
        category = Target.Cells(1).Offset(0, -1).value
        ' Wenn sowohl Wert als auch Kategorie nicht leer sind ...  
        If category <> "" And value <> "" Then  
            ' Durchlaufe Array-Werte (getrennt anhand von Kommas oder Semikolons)  
            For Each val In Split(Replace(value, ";", ",", 1, -1, 1), ",", -1, 1)  
              If val <> "" then  
                With wsOverview
                    ' find die passende Kategoriespalte im benannten Bereich "Kategorien" in der Übersicht  
                    Set catRange = .Range("Kategorien").Find(category, LookIn:=xlValues, LookAt:=xlWhole)  
                    ' wenn es die Kategorie gibt  
                    If Not catRange Is Nothing Then
                        ' Suche den eingetragenen Wert in der Kategorie-Spalte  
                        If Not catRange.EntireColumn.Find(Trim(val), LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
                            ' zeige eine Meldung das der Wert bereits vorhanden ist  
                            MsgBox "Eingetragener Wert '" & Trim(val) & "' ist bereits in der Kategorie '" & category & "' vorhanden!", vbExclamation  
                            ' Wert der Zelle auf Ursprungswert zurücksetzen                              
                            Application.EnableEvents = False
                            Target.Cells(1).value = lastValue
                            Application.EnableEvents = True
                        Else
                            ' Wert ist noch nicht vorhanden, also hänge ihn ans Ende der Kategorie in der Übersicht  
                            .Cells(Rows.Count, catRange.Column).End(xlUp).Offset(1, 0).value = Trim(val)
                        End If
                    End If
                End With
              End If
            Next
        End If
    End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    lastValue = Target.Cells(1).value
End Sub