Hallo, Gast77191!

Sorry! Ich wollte das Forum natürlich nicht mißbrauchen. Ich habe mittlerweile Hilfestellung aus einem anderen Forum in Form eines Codes von Carsten aus Bremen erhalten, welcher perfekt für meine Liste paßt (auf diesem Weg nochmals Danke an Carsten, falls er sich auch in diesem Forum tummelt).

Den Code möchte ich euch nicht vorenthalten, da vielleicht der ein oder andere mit ähnlichen Aufgabenstellungen zu kämpfen hat:

Sub SearchString()
' http://www.vb-paradise.de/programmieren/visual-basic-for-applications-vba/69901-vba-zelle-vergleichen-und-bei-bedingung-kopieren-finden/
' CaBe
' Version 1.0
' 13.06.2013

    Dim Sheet1 As Worksheet
    Dim Sheet2 As Worksheet
    Dim LastRow As Long
    Dim lRow As Long, i As Integer
    Dim SearchString As String
    Dim Found As Range
   
    Set Sheet1 = Worksheets("Inventar")
    Set Sheet2 = Worksheets("Standort")
   
    LastRow = FindLastRow(Sheet1, "A")
    For lRow = 3 To LastRow
        ' Die nachfolgende Codezeile würde funktionieren,
        ' wenn alle Inv.Nr. als Text vorlägen
        'SearchString = CStr(Left(Sheet1.Cells(lRow, "A"), 12))
       
        ' Alternativ wird der Zellinhalt Zeichen für Zeichen
        ' in einen String gewandelt
        SearchString = CStr(Left(Sheet1.Cells(lRow, "A"), 1))
        For i = 2 To 13
            ' Falls Komma enthalten, keine String-Umwandlung
            If Not Mid(Sheet1.Cells(lRow, "A"), i, 1) = "," Then
                SearchString = SearchString & Mid(Sheet1.Cells(lRow, "A"), i, 1)
            End If
        Next i
        ' Stringlänge auf 12 reduzieren (wegen Kommabehandlung war Länge = 13)
        SearchString = Left(SearchString, 12)
       
        Set Found = FindString(SearchString, Sheet2.Columns("D"), , xlPart)
        If Not (Found Is Nothing) Then
            Sheet1.Cells(lRow, "E") = Sheet2.Cells(Found.Row, "A")
            Sheet1.Cells(lRow, "F") = Sheet2.Cells(Found.Row, "B")
            Sheet1.Cells(lRow, "G") = Sheet2.Cells(Found.Row, "C")
            Sheet1.Cells(lRow, "H") = Sheet2.Cells(Found.Row, "E")
        End If
    Next lRow
   
    Set Sheet1 = Nothing
    Set Sheet2 = Nothing
End Sub

Public Function FindLastRow(ByVal WS As Worksheet, ColumnLetter As String) As Long
    FindLastRow = WS.Range(ColumnLetter & "65536").End(xlUp).Row
End Function

Function FindString(Find_Item As Variant, Search_Range As Range, _
                Optional LookIn As XlFindLookIn = xlValues, _
                Optional LookAt As XlLookAt = xlPart, _
                Optional MatchCase As Boolean = False) As Range

    Dim c As Range
    Set FindString = Nothing
    With Search_Range
        Set FindString = .Find( _
                        What:=Find_Item, _
                        LookIn:=LookIn, _
                        LookAt:=LookAt, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=MatchCase, _
                        SearchFormat:=False)
    End With
End Function

Liebe Grüße

dervish65