Gruppe
Feature
Problem
Wie kann ich erreichen, dass alle Zellen in Spalte A, in denen kein Wert steht, gelb hinterlegt sind. Wir dein Wert eingetragen, soll die Hintergrundfarbe gelöscht werden.
StandardModule: Modul1
Sub DeleteRange()
Dim wks As Worksheet
Dim rng As Range
Dim iCounter As Integer
For iCounter = ActiveSheet.Index + 1 To Worksheets.Count
Set wks = Worksheets(iCounter)
Set rng = RealLastCell(wks)
wks.Rows(rng.Row + 1 & ":" & Rows.Count).Delete
wks.Range(wks.Cells(1, rng.Column + 1), _
wks.Cells(1, 256)).EntireColumn.Delete
Next iCounter
End Sub
Function RealLastCell(TheSheet As Worksheet) As Range
Dim ExcelLastCell As Range
Dim Row%, Col%, LastRowWithData%, LastColWithData%
Application.ScreenUpdating = False
Set ExcelLastCell = TheSheet.Cells.SpecialCells(xlLastCell)
LastRowWithData = ExcelLastCell.Row
Row = ExcelLastCell.Row
Do While Application.CountA(TheSheet.Rows(Row)) = 0 And Row <> 1
Row = Row - 1
Loop
LastRowWithData = Row
LastColWithData = ExcelLastCell.Column
Col = ExcelLastCell.Column
Do While Application.CountA(TheSheet.Columns(Col)) = 0 And Col <> 1
Col = Col - 1
Loop
LastColWithData = Col
Set RealLastCell = TheSheet.Cells(Row, Col)
End Function