Hallo Zusammen,

Ich zermatere mir jetzt schon seit ein paar Tagen das Hirn über folgendes Problem:

Ich habe für die Arbeit ein Makro erstellt, welches eine Tabelle mit +150 Einträgen nach einem bestimmten Kürzel durchsuchen soll, welches variabel in einer festgelegten Zelle eingetragen werden kann. Wird das Kürzel in einer Zeile gefunden, kopiert es drei Einträge aus der Zeile in ein Array und überträgt diese dann in Zeilen auf einem zweiten Arbeitsblatt, druckt dieses aus und macht mit der nächsten Zeile weiter.

Das funktioniert soweit auch ganz gut. Mein Problem ist, dass das Makro nicht nur explizit nach dem gesuchten Kürzel sucht, sondern nach jeder Zeile, in der das eingetragene Kürzel vorkommt. Sprich ich suche nach dem Kürzel W1, es spuckt mir W1 und VW1 aus.

Ich hab ehrlich gesagt genau 0 Ahnung vom Programmieren und habe mir das Makro in stundenlanger recherchearbeit so zusammengesetzt. Meine Vermutung war, dass irgendwo ein Matchwholeword = true reingehört, bekomme es aber beim besten Willen nicht funktionsfähig nur durch try and error heraus wo. Vielleicht hat von euch ja wer eine Idee. Danke dafür schonmal im Voraus! :)

Sub SuchenUndFinden()

'Variablen
Dim finden As Range             'durchsucht Spalten nach Suchbegriffen
Dim treffer As String               'Wo wurde der Begriff gefunden? Angabe der Zelle
Dim Tour()                               'Array: Speichert die gewünschten Einträge
Dim size As Integer                 'passt die Größe des Arrays an

'Programm

Set finden = Columns(1).Find(what:=Range("B23"))      'Hier liegt das Problem, es soll nach genau dem Kürzel in B23 gesucht werden

    If Not finden Is Nothing Then

    treffer = finden.Address        'Speichert die erste Adresse
    MsgBox treffer

      Do
      ReDim Preserve Tour(2, size)
    
           If finden.Value = "" Then
        
               Else
                Tour(0, size) = finden.Offset(0, 2).Value 'Baustelle
                Tour(1, size) = finden.Offset(0, 3).Value 'Startdatum
                Tour(2, size) = finden.Offset(0, 7).Value 'Projektnummer
            
                Worksheets("Blanko Wartungsprotokoll").Range("D3:L3") = Tour(0, 0)
                Worksheets("Blanko Wartungsprotokoll").Range("D4:L4") = Tour(1, 0)
                Worksheets("Blanko Wartungsprotokoll").Range("A2:C2") = Tour(2, 0)

                    Sheets("Blanko Wartungsprotokoll").Select
                    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
                    IgnorePrintAreas:=False
                
            
                Sheets("Übersicht Kontrolltouren").Select
        
            Erase Tour

        
           End If
           
               
    Set finden = Columns(1).FindNext(finden)
    
    Loop While Not finden Is Nothing And treffer <> finden.Address
    
    
End If

End Sub