VBA - Leere Zellen durch Tastenkombination löschen
05.11.2018 12:09:13
marc4791
Hallo liebe Helfende!
Ich bin Neuling in VBA und versuche mal mein Problem verständlich zu beschreiben.
Ich muss eine xlsm-Datei neu machen, weil die alte total zerschossen war.
Es soll eine Auswahl von Mitarbeitern für verschiedene Kurse über ein Drop-down-Menü erfolgen.
Also, ich wähle einen Kurs an, und aus der Liste der Mitarbeiter werden diejenigen ausgesucht, bei denen der Kurs angegeben wurde.
Es gibt 11 Kurse, in jedem sind andere Mitarbeiter und das Blatt soll für den Kurs-Leiter ohne Leerzeilen zwischen den Namen ausgedruckt werden. Hab mal ein Bild angehängt - Namen sind geschwärzt (Datenschutz usw.)
Nun habe ich die Ziel-Tabelle, in der in 4 Spalten (= 4 Arbeitsbereiche) die Namen der Mitarbeiter automatisch eingefügt werden.
Da die Quell-Tabelle 100 Zeilen umfasst (und NICHT geändert werden darf), aber nur ca 40 Mitarbeiter vorhanden sind, gibt es in der Ziel-Tabelle viele Leerzellen.
Die Ziel-Tabelle konnte in der alten Datei (2002 erstellt) durch drücken von Strg+O bereinigt werden, heißt, alle Mitarbeiter wurden untereinander sortiert und dann erst die Leerzellen. Also erst Name - frei - frei - Name - frei, dann Name - Name - frei - frei - frei.
Den Code habe ich aus der alten Datei kopiert (siehe unten) - und funktioniert nicht in der neuen. Im MS VBA-Editor komme ich über "Debuggen" - "Ausführen bis Cursor-Position" zwar an mein Ziel, ist aber nicht Sinn und Zweck.
Quasi sollen alle schwarzen Felder untereinander stehen und dann die Leerzeilen (wie in Spalte "LL KV BF")
Ich hoffe, es verständlich 'rüber gebracht zu haben.
Sub Makro3()
' Makro3 Makro
' Namen sortieren
' Tastenkombination: Strg+o
Range("D14:D33").Select
ActiveWorkbook.Worksheets("Kurszettel").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Kurszettel").Sort.SortFields.Add Key:=Range( _
"D14"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Kurszettel").Sort
.SetRange Range("D14:D33")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("E14:E33").Select
ActiveWorkbook.Worksheets("Kurszettel").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Kurszettel").Sort.SortFields.Add Key:=Range( _
"E14"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Kurszettel").Sort
.SetRange Range("E14:E33")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("F14:F33").Select
ActiveWorkbook.Worksheets("Kurszettel").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Kurszettel").Sort.SortFields.Add Key:=Range( _
"F14"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Kurszettel").Sort
.SetRange Range("F14:F33")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("G14:G33").Select
ActiveWorkbook.Worksheets("Kurszettel").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Kurszettel").Sort.SortFields.Add Key:=Range( _
"G14"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Kurszettel").Sort
.SetRange Range("G14:G33")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("H14:H33").Select
ActiveWorkbook.Worksheets("Kurszettel").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Kurszettel").Sort.SortFields.Add Key:=Range( _
"H14"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Kurszettel").Sort
.SetRange Range("H14:H33")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
