630 Aufrufe
Gefragt in Tabellenkalkulation von
Hallo Spezis,
ich hab da mal ein Makroproblem und zwar:
Im Tabellenblatt "Eingabe 1" sind in den Spalten A - E verschiedene Daten eingetragen.
Diese werden per Makro in Tabellenblatt "MBR 1" kopiert ,mit Autofilter nach leeren "Zellen" in bestimmten "Spalten" gefiltert und dann die gefundenen "Zeilen" - in der sich die leeren "Zellen" befinden - kompletten gelöscht. Soweit so gut.
Wenn ich jetzt inTabellenblatt Eingabe 1 Einträge ändere oder neue hizufüge oder lösche und sich die leeren "Zellen" dann an anderer Stelle befinden werden die zu löschenden "Zeilen" nicht mehr richtig erkannt.
Gibt es eine Möglichkeit ein Makro "dynamisch" zu machen damit immer die aktuellen Einträge in Tabellenblatt Eingabe 1 ausgewertet werden?

Hier mein Makro:
Sub MBR1_erstellen()
'
' MBR1_erstellen Makro
'

'
Sheets("Eingabe 1").Select
Range("A6:E250").Select
Selection.Copy
Sheets("MBR1").Select
Range("A6").Select
ActiveSheet.Paste
Range("A5:E250").Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveSheet.Range("$A$5:$E$250").AutoFilter Field:=5, Criteria1:="="
Rows("6:58").Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$A$5:$E$250").AutoFilter Field:=5
Selection.AutoFilter
Range("A5:E53").Select
ActiveWorkbook.Worksheets("MBR1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("MBR1").Sort.SortFields.Add Key:=Range("E6:E53"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("MBR1").Sort.SortFields.Add Key:=Range("B6:B53"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("MBR1").Sort
.SetRange Range("A5:E53")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A6").Select
End Sub

1 Antwort

0 Punkte
Beantwortet von m-o Profi (22.9k Punkte)
Hallo,

ich habe keine Ahnung, ob ich dich richtig verstanden habe.
Meinst du das etwa so:
Sub MBR1_neu()

Dim loletzte As Long

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'letzte Zeile im Arbeitsblatt MBR1 in Spalte A ermitteln
loletzte = Worksheets("MBR1").Cells(Rows.Count, 1).End(xlUp).Row

'Bereich ab Zeile 6 löschen
With Worksheets("MBR1")
.Range(.Cells(6, 1), .Cells(loletzte, 5)).ClearContents
End With

'letzte Zeile im Arbeitsblatt Eingabe 1 in Spalte A ermitteln
loletzte = Worksheets("Eingabe 1").Cells(Rows.Count, 1).End(xlUp).Row

With Worksheets("Eingabe 1")
.Range(Cells(5, 1), Cells(loletzte, 5)).AutoFilter Field:=5, Criteria1:="<>" 'alle Zeilen mit leeren Zellen in Spalte E ausblenden
.Range(Cells(6, 1), Cells(loletzte, 5)).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("MBR1").Range("A6") 'nun nur die sichbaren Zellen kopieren
.ShowAllData 'Filterung wieder aufheben
.Range(Cells(5, 1), Cells(loletzte, 5)).AutoFilter 'Autofilter wieder aus
End With

'letzte Zeile im Arbeitsblatt MBR1 in Spalte A ermitteln
loletzte = Worksheets("MBR1").Cells(Rows.Count, 1).End(xlUp).Row

'sortieren
With Worksheets("MBR1").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("E6:E" & loletzte), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("B6:B" & loletzte), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A5:E" & loletzte)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

With Worksheets("MBR1")
.Activate
.Range("A6").Select
End With

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Ansonsten erkläre dein Problem mal etwas genauer.

Gruß

M.O.
...