ich bin neu hier im Forum und brauche ein wenig hilfe zu meinen schwachen VBA Kenntnissen.
Ich möchte ein Makro schreiben das aus dem ersten Tabellenblatt die Werte kumuliert übernimmt und in das zweite Tabellenblatt schreibt. Soweit klappt das ganz gut. Da sich der Programmcode aber wiederholt möchte ich das gerne mit einer Schleife machen weiß aber nicht wie ich es anstellen soll.
Ich habe es jetzt so geregelt das er eine bestimmte Zelle ansprechen soll auf dem Blatt und wenn er nichts einfügt, dass die leeren Zeilen gelöscht werden soll. Damit es dann später weiter untereinander steht. Aber das ist ziemlich mühseelig. Besonders wenn ich später noch weitere aufgaben dazwischen einfügen möchte. Da müsste ich dann alle Zellen anpassen.
'Tapeten entfernen (Wände)
If Application.WorksheetFunction.SumIf(Worksheets("Aufnahmeblatt").Columns(2), "Tapeten entfernen (Wände)", Worksheets("Aufnahmeblatt").Columns(7)) > 0 Then
Cells(8, 1) = "1"
Cells(8, 2) = "Tapenten entfernen (Wände)"
Range(Cells(8, 2), Cells(8, 3)).MergeCells = True
Range("B8").Font.Bold = True
Cells(9, 2) = "Tapete oder Raufaser mit oder ohne Anstrich einschließlich Makulatur und Kleisterresten restlos entfernen und entsorgen Einschließlich aller Nebenarbeiten."
Rows("9:9").RowHeight = 80
Range(Cells(9, 2), Cells(9, 3)).MergeCells = True
Cells(8, 4) = Application.WorksheetFunction.SumIf(Worksheets("Aufnahmeblatt").Columns(2), "Tapeten entfernen (Wände)", Worksheets("Aufnahmeblatt").Columns(7))
Cells(8, 5) = "m²"
Range("D9").Value = "leer"
With Range("D9").Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Range("F8,H8").Borders(xlEdgeBottom)
.LineStyle = xlDot
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Else
Cells(8, 1) = ""
Cells(8, 2) = ""
Cells(8, 4) = ""
Cells(8, 5) = ""
Cells(9, 2) = ""
Cells(9, 4) = ""
End If
'Tapeten entfernen (Decke)
If Application.WorksheetFunction.SumIf(Worksheets("Aufnahmeblatt").Columns(2), "Tapeten entfernen (Decke)", Worksheets("Aufnahmeblatt").Columns(7)) > 0 Then
Cells(10, 1) = "2"
Cells(10, 2) = "Tapenten entfernen (Decken)"
Range(Cells(10, 2), Cells(10, 3)).MergeCells = True
Range("B10").Font.Bold = True
Cells(11, 2) = "Tapete oder Raufaser mit oder ohne Anstrich einschließlich Makulatur und Kleisterresten restlos entfernen und entsorgen Einschließlich aller Nebenarbeiten."
Rows("11:11").RowHeight = 80
Range(Cells(11, 2), Cells(11, 3)).MergeCells = True
Cells(10, 4) = Application.WorksheetFunction.SumIf(Worksheets("Aufnahmeblatt").Columns(2), "Tapeten entfernen (Decke)", Worksheets("Aufnahmeblatt").Columns(7))
Cells(10, 5) = "m²"
Range("D11").Value = "leer"
With Range("D11").Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Range("F10,H10").Borders(xlEdgeBottom)
.LineStyle = xlDot
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Else
Cells(10, 1) = ""
Cells(10, 2) = ""
Cells(10, 4) = ""
Cells(10, 5) = ""
Cells(11, 2) = ""
Cells(11, 4) = ""
End If
Dim intRow As Integer, intLastRow As Integer
intLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
For intRow = intLastRow To 1 Step -1
If Application.CountA(Rows(intRow)) = 0 Then
intLastRow = intLastRow - 1
Else
Exit For
End If
Next intRow
For intRow = intLastRow To 1 Step -1
If IsEmpty(Cells(intRow, 4)) Then
Rows(intRow).Delete
End If
Next intRow