in einer Liste möchte ich per VBA leere Zeilen löschen (eine Datenübertragung von der Kalkulation zu einer Art mitlaufenden Kalkulation. Es sollen nur Zeilen gelöscht werden, deren Zelle Cx leer sind (in den C-Zellen stehen die Stückzahlen drin).
Ich habe in meiner Kalkulation mehrere Datensätze rein geschrieben und dazwischen befinden sich ab un zu auch mal leere Zeilen, bzw. Zeilen, deren Zelle C leer ist. Eben diese möchte ich mit dem Befehl
Range("C2:C500").SpecialCells(xlCellTypeBlanks).EntireRow.Delete löschen. Sofern ich keine leeren Zellen zwischendurch haben, sondern nur welche am Ende (in den unteren Zeilen) funktioniert das ganze einwandfrei. Andernfalls kommt die Fehlermeldung
Laufzeitfehler '1004':
Die Delete-Methode des Range-Oblektes konnte nicht ausgeführt werden.
Hier ist nochmal der gesamte Code:
Sub Datenübergabe_Kalku_zu_MIKA_Daten()
Application.ScreenUpdating = False
''Tabelle formatieren
Sheets("MIKA-Daten").Range("B1:M500").Select
Selection.ClearContents
Sheets("Liste").Select
Range("K1:V1").Select
Selection.Copy
Sheets("MIKA-Daten").Select
Range("B1").Select
ActiveSheet.Paste
Sheets("MIKA-Daten").Range("B1:M500").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$1:$M$500"), , xlYes).Name = _
"Tabelle2"
Range("Tabelle2[#All]").Select
ActiveSheet.ListObjects("Tabelle2").TableStyle = "TableStyleMedium16"
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
''Zahlenformatierung hinzufügen
Range("Tabelle2[Pos.]").Select
Selection.NumberFormat = "@"
Range("Tabelle2[Menge]").Select
Selection.NumberFormat = "0.00"
Range("Tabelle2[[EK-Einzelpreis]:[EK-Gesamtpreis Nachverhandelt]]").Select
Selection.NumberFormat = "#,##0.00 $"
Range("E2:E500,J2:M500").Select
Range("J500").Activate
Selection.NumberFormat = "@"
''Spaltenbreiten einfügen
Columns("B:B").Select
Selection.ColumnWidth = 10
Columns("C:C").Select
Selection.ColumnWidth = 10
Columns("D:D").Select
Selection.ColumnWidth = 10
Columns("F:I").Select
Selection.ColumnWidth = 15
Columns("J:M").Select
Selection.ColumnWidth = 35
''Daten kopieren und einfügen
Sheets("Kalkulation").Range("C4:C500").Copy
Sheets("MIKA-Daten").Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks _
:=False, Transpose:=False
Sheets("Kalkulation").Range("D4:F500").Copy
Sheets("MIKA-Daten").Range("C2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks _
:=False, Transpose:=False
Sheets("Kalkulation").Range("L4:L500").Copy
Sheets("MIKA-Daten").Range("F2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks _
:=False, Transpose:=False
Sheets("Kalkulation").Range("G4:J500").Copy
Sheets("MIKA-Daten").Range("J2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks _
:=False, Transpose:=False
''Formel zur Berechnung des Gesamtpreises einfügen
Range("G2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=[@[EK-Einzelpreis]]*[@Menge]"
Range("C2:C500").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Ich danke Euch schon einmal vielmals im Voraus
Gruß Gregy