50 Zeilen einblenden

Sub neuezeile() Application.ScreenUpdating = False ActiveSheet.Unprotect "MML_RW" Dim Zelle As Range ActiveCell.EntireRow.Copy Cells(ActiveCell.Row + 1, 1).Insert Shift:=xlDown For Each Zelle In Range(Cells(ActiveCell.Row + 1, 1), Cells(ActiveCell.Row + 1, 255).End( _ xlToLeft)) If Not Zelle.HasFormula Then Zelle.ClearContents End If Next Zelle Cells(ActiveCell.Row + 1, 1).Select ActiveSheet.Protect Password:="MML_RW", AllowFiltering:=True, AllowFormattingCells:=True, _ AllowFormattingColumns:=True, AllowFormattingRows:=True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Chris,
mega das klappt, vielen Dank :). Momentan wird ab der aktiven Zeile 50 Zeilen eingefügt, hast du mir ein Tipp wie ich es schaffe, dass ab der letzten Zeile 50 Zeilen eingefügt werden ?
funktionierender Code ab aktiven Zeile:

Sub neuezeile()
Application.ScreenUpdating = False
ActiveSheet.Unprotect "MML_RW"
Dim Zelle As Range
ActiveCell.EntireRow.Copy
Rows(ActiveCell.Row + 1 & ":" & ActiveCell.Row + 50).Insert Shift:=xlDown
For Each Zelle In Range(Cells(ActiveCell.Row + 1, 1), Cells(ActiveCell.Row + 1, 255).End( _
xlToLeft))
If Not Zelle.HasFormula Then
Zelle.ClearContents
End If
Next Zelle
Cells(ActiveCell.Row + 1, 1).Select
ActiveSheet.Protect Password:="MML_RW", AllowFiltering:=True, AllowFormattingCells:=True,  _
AllowFormattingColumns:=True, AllowFormattingRows:=True
End Sub

Ab letzter Zeile einfügen:
( mein Versuch, macht aber nicht, dass was es soll, sondern fügt ab A1 50 Zeilen hinzu).

Sub fuenfzigZeilen()
Application.ScreenUpdating = False
ActiveSheet.Unprotect "MML_RW"
Dim letztezeile
letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Dim Zelle As Range
ActiveSheet.Range("A1:A" & letztezeile).Copy
Rows(letztezeile + 1 & ":" & letztezeile + 50).Insert Shift:=xlDown
'For Each Zelle In Range(Cells(letztezeile + 1, 1), Cells(letztezeile + 1, 255).End(xlToLeft))
'If Not Zelle.HasFormula Then
'ActiveSheet.Range("A1:A" & letztezeile).ClearContents
'End If
'Next Zelle
Cells(letztezeile + 1, 1).Select
ActiveSheet.Protect Password:="MML_RW", AllowFiltering:=True, AllowFormattingCells:=True,  _
AllowFormattingColumns:=True, AllowFormattingRows:=True
End Sub

Liebe Grüße,
Nati

Sub neueZeilen() Dim Zelle As Range Dim letzteZeile As Long Application.ScreenUpdating = False With ActiveSheet .Unprotect "MML_RW" letzteZeile = .Cells(Rows.Count, 1).End(xlUp).Row .Rows(letzteZeile).EntireRow.Copy .Rows(letzteZeile + 1 & ":" & letzteZeile + 50).Insert Shift:=xlDown For Each Zelle In .Range(.Cells(letzteZeile + 1, 1), .Cells(letzteZeile + 50, 255).End( _ xlToLeft)) If Not Zelle.HasFormula Then Zelle.ClearContents Next Zelle .Cells(letzteZeile + 1, 1).Select .Protect Password:="MML_RW", AllowFiltering:=True, AllowFormattingCells:=True, _ AllowFormattingColumns:=True, AllowFormattingRows:=True End With End Sub

Sub fuenfzigNeueZeilen() Dim Zelle As Range Dim letzteZeile As Long Application.ScreenUpdating = False With ActiveSheet .Unprotect "MML_RW" letzteZeile = .Cells(1048576, 2).End(xlUp).Row .Rows(letzteZeile).EntireRow.Copy .Rows(letzteZeile + 1 & ":" & letzteZeile + 50).Insert Shift:=xlDown For Each Zelle In .Range(.Cells(letzteZeile + 1, 1), .Cells(letzteZeile + 50, 255).End( _ xlToLeft)) If Not Zelle.HasFormula Then Zelle.ClearContents Next Zelle .Cells(letzteZeile + 1, 1).Select .Protect Password:="MML_RW", AllowFiltering:=True, AllowFormattingCells:=True, _ AllowFormattingColumns:=True, AllowFormattingRows:=True End With End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread