Moin,

ich habe ein Makro was aus mehreren Bereichen die Daten herauszieht.

Die Duplikate werden gelöscht und übrig bleiben eben ein paar Namen.

Leider sind in der Quelldatei auch leere, unbeschriebene Zellen.

Diese verschwinden auch nach dem Sortieren leider nicht.

Somit habe ich ganz oben in meiner Liste eine leere Zelle.

"Leere Zelle"
A
B
C

Gibt es eine Möglichkeit diese "Leere Zelle" irgendwo herauszufiltern?

Hier das Makro:

Sub AusbilderErmittelnEvaluation()

    Sheets("Stundenplan").Select
    
   'sucht die Bereiche mit den Namen
    Range("B11:K12,B27:K28,B48:K49").Select
    Range("B11:K12,B27:K28,B48:K49,B64:K65").Select
    Range("B11:K12,B27:K28,B48:K49,B64:K65,B85:K86,B101:K102,B122:K123").Select
    Range( _
        "B11:K12,B27:K28,B48:K49,B64:K65,B85:K86,B101:K102,B122:K123,B138:K139,B159:K160" _
        ).Select
    Range( _
        "B11:K12,B27:K28,B48:K49,B64:K65,B85:K86,B101:K102,B122:K123,B138:K139,B159:K160,B175:K176,B196:K197,B212:K213" _
        ).Select
    
    
   'Ausbilder-Daten aus Stundenplan werden kopiert
    Selection.Copy
    
    'Evaluationsbogen ausgewählt und Daten in N4 kopiert
    Sheets("Evaluationsbogen").Select
    Range("N4").Select
    
    
    
    'fügt die Daten aus dem Stundenplan in das Tabellenblatt evaluationsbogen ein. Bis hierher alles ok
        ActiveSheet.Paste
    
    
    
    Range("P4:Q27").Select
    Application.CutCopyMode = False
    Selection.Cut
    Range("N28").Select
    ActiveSheet.Paste
    Range("R4:S27").Select
    Selection.Cut
    Range("N52").Select
    ActiveSheet.Paste
    Range("T4:U27").Select
    Selection.Cut
    Range("N76").Select
    ActiveSheet.Paste
    Range("V4:W27").Select
    Selection.Cut
    Range("N100").Select
    ActiveSheet.Paste
    Range("N4:N123").Select
    
    
    
    'entfert die Duplikate
    
    ActiveSheet.Range("$N$4:$N$123").RemoveDuplicates Columns:=1, Header:=xlNo
   
    ActiveWorkbook.Worksheets("Evaluationsbogen").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Evaluationsbogen").Sort.SortFields.Add2 Key:=Range _
        ("N4:N123"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Evaluationsbogen").Sort
        .SetRange Range("N4:N123")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
   'Ab hier noch mal sortieren
   
    
    
    
    
    Selection.Copy
    Range("H14").Select
    ActiveSheet.Paste
    
    

    
  '#bis hierher alles ok, die Daten sind jetzt in "Dozentennamen eingetragen
  
  
  
    
    Dim arWorte As Variant, varWort As Variant, varItem As Variant
   
   arWorte = Array(".*", "homeoffice*", "frei", "Homeoffice", "Feiertag", "Selbststudium", " ")
   
   
   
   
   For Each varItem In Array("Evaluationsbogen")
      With Worksheets(CStr(varItem)).Range("H14:H40")
         For Each varWort In arWorte
            .Replace CStr(varWort), "", lookat:=xlWhole, MatchCase:=False
         Next
      End With
   Next
   
    
       Range("H14:H39").Select
    ActiveWorkbook.Worksheets("Evaluationsbogen").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Evaluationsbogen").Sort.SortFields.Add2 Key:=Range _
        ("H14:H39"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Evaluationsbogen").Sort
        .SetRange Range("H14:H39")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
     Columns("N:O").Delete
    
    End Sub
    
 

Liebe Grüße in die Runde!