Zeilen einfügen in Abschnitt

Sub Testfürmich() ' Testfürmich Makro 'Dim i, j, lz As Long ' Application.ScreenUpdating = False lz = ActiveCell.SpecialCells(xlLastCell).Row ' Cells(lz, 35).Select Selection.End(xlUp).Select ' j = ActiveCell.Row ActiveCell.EntireRow.Select Selection.Copy Selection.Insert Shift:=xlDown For i = 1 To 4 ' Cells(j + 1, i).ClearContents Next Application.ScreenUpdating = True End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Alexander,
probiere mal die folgenden Makros, ob sie das machen was du wünscht.
ggf. musst du einige Zeilen im makro noch an deine Arbeitsmappe anpassen.
Wenn es funktioniert, dann kann diese beiden Makros dann von den Ereignismakros beim öffnen bzw. vor dem Speichern starten.
Gruß
Franz

Sub Zeilen_Einfuegen()
' Zeilen mit Formeln an den Abschnittsenden anfügenTestfürmich Makro
Const Zei_A1 As Long = 1 '=1. zeile des 1. Abschnitts
Dim wks As Worksheet
Dim Zeile_L As Long
Dim Spal_L As Long, Spa As Long, Spa_F As Long
Set wks = ThisWorkbook.Worksheets(1) 'Name oder Index-Nummer ggf. anpassen
Application.ScreenUpdating = False
With wks
Spa_F = .Range("AI1").Column 'Spalte in der eine Formel steht - ggf. anpassen
Zeile_L = Zei_A1
Do
If IsEmpty(.Cells(Zeile_L + 1, Spa_F)) Then
Zeile_L = Zeile_L + 1
Else
Zeile_L = .Cells(Zeile_L, Spa_F).End(xlDown).Row
If Zeile_L = .Rows.Count Then Exit Do
Zeile_L = Zeile_L + 1
End If
.Rows(Zeile_L).Insert shift:=xlShiftDown
.Rows(Zeile_L - 1).Copy Destination:=.Rows(Zeile_L)
For Spa = 1 To .Cells(Zeile_L, .Columns.Count).End(xlToLeft).Column
If Not .Cells(Zeile_L, Spa).HasFormula Then
.Cells(Zeile_L, Spa).ClearContents
End If
Next
Zeile_L = .Cells(Zeile_L, Spa_F).End(xlDown).Row
If Zeile_L = .Rows.Count Then Exit Do
Loop
End With
Application.ScreenUpdating = True
End Sub
Sub Zeilen_Loeschen_leer()
' Zeilen mit Formeln an den Abschnittsenden löschen, wenn nicht ausgefüllt
Const Zei_A1 As Long = 1 '=1. zeile des 1. Abschnitts
Dim wks As Worksheet
Dim Zeile_L As Long
Dim Anz_Formel As Long, Spa_F As Long
Set wks = ThisWorkbook.Worksheets(1) 'Name oder Index-Nummer ggf. anpassen
Application.ScreenUpdating = False
With wks
Spa_F = .Range("AI1").Column 'Spalte in der eine Formel steht - ggf. anpassen
Zeile_L = Zei_A1
Do
If IsEmpty(.Cells(Zeile_L + 1, Spa_F)) Then
'do nothing - Abschnitt hat nur eine Zeile
Else
Zeile_L = .Cells(Zeile_L, Spa_F).End(xlDown).Row
If Zeile_L = .Rows.Count Then Exit Do
If Not .Cells(Zeile_L - 1, Spa_F).HasFormula Then
'do nothing - 1. Zeile im Abschnitt mit Formel
Else
Anz_Formel = .Rows(Zeile_L).SpecialCells(xlCellTypeFormulas).Count
If Anz_Formel = Application.WorksheetFunction.CountA(.Rows(Zeile_L).Cells)  _
Then
.Rows(Zeile_L).Delete shift:=xlShiftUp
End If
End If
End If
Zeile_L = .Cells(Zeile_L, Spa_F).End(xlDown).Row
If Zeile_L = .Rows.Count Then Exit Do
Loop
End With
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread