AW: Makro nur einmal starten
19.12.2018 16:41:59
Peter
Hallo Werner, ja das Sheet wird verlassen, um die Anzahl der Zeilen festzustellen, die ich dann in Ausgabe zum Kopieren brauche.
Gruß Peter
Hier der Code.
Sub Loeschen_1()
Application.ScreenUpdating = False ' BS ausschalten
Sheets("Kalkulation über Artikel").Select
lzz = Cells(Rows.Count, 2).End(xlUp).Rows.Row ' letzte Zeile in Sheet Kalkulation
msgbox "Anzahl Zeilen insgesamt in Kalkulation über Artikel: " & lzz
Sheets("Ausgabe").Select
Range("B11:D11").Select
Selection.Copy
Range("B13", "D" & lzz + 10).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("B13").Select
Range("B13", "D" & lzz).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A13").Select
lza = Cells(Rows.Count, 2).End(xlUp).Rows.Row ' löschen Zeilen, wenn Werte = 0
'** Durchlauf aller Zeilen von unten
For t = lza To 12 Step -1 'Zählt rückwärts bis Zeile 12
'Abfragen, ob in den Spalten 0 steht
If Cells(t, 2).Value = 0 Then
Rows(t).Delete Shift:=xlUp
C = C + 1
End If
Next t
msgbox "Anzahl gelöschte Zeilen: " & C
C = 0
lza1 = Cells(Rows.Count, 2).End(xlUp).Rows.Row ' löschen Zeilen, wenn Werte = 0
Range("A13", "D" & lza1).Select
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
'ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select
' Selection.Delete
' Range("C12").Select
Application.ScreenUpdating = True ' BS wieder einschalten
Range("A12").Select
End Sub