wenn Funktion als Makro
meixner
Hallo zusammen,
möchte bei dem unteren Makro (bei dem mir schon der Rudi geholfen hat) noch eine wenn - Funktion einbauen. Wenn die Zelle in der Spalte BB leer ist, dann soll das Makro die Nachbarzellen AX:BA in dieser Zeile löschen.
Vielen Dank.
Dani
Sub wennFunktion()
Dim objSh As Worksheet
Dim lngRow As Long, lngLast As Long, lngNext As Long
lngNext = 2
Set objSh = Sheets("Tabelle2") 'Zieltabelle
With Sheets("Tabelle3") 'Quelltabelle
lngLast = Application.Max(2, .Cells(Rows.Count, 51).End(xlUp).Row)
.Columns(54).Insert
.Range("BB8").Formula = "=IF(COUNTIF($Ax$8:$Ax8,Ax8)=1,SUMIF($Ax$8:$Ax$" & _
CStr(lngLast) & ",Ax8,$BA$8:$BA$" & CStr(lngLast) & "),"""")"
.Range("BB8:BB" & CStr(lngLast)).FillDown
objSh.Range("Ax8:BA" & Rows.Count).Clear
For lngRow = 8 To lngLast
If .Cells(lngRow, 54) "" Then
objSh.Cells(lngNext, 51) = .Cells(lngRow, 51)
objSh.Cells(lngNext, 52) = .Cells(lngRow, 52)
objSh.Cells(lngNext, 53) = .Cells(lngRow, 54)
lngNext = lngNext + 1
End If
Next
.Columns(55).Delete
End With
End Sub