AW: Letzte frei Zeile suchen und Zeile kop.
17.11.2022 08:33:17
Ralf
Bitte nicht erschrecken :-) bin Anfänger
Anliegen: die SN abfrage sollte ersetzt werden mit Suche die letzte Frei Zeile in welcher in Spalte E (5) kein Eintrag vorhanden ist. und dann sollte in den nächsten 5 Zeilen die Formeln und Formt der letzten Zeile übernehmen.
1. Frage SN Abfrage sollte durch diesen ersetzt werden.
Dim Letztezeile As Long
Letztezeile = Cells(Rows.Count, 5).End(xlUp).Row
Cells(Letztezeile + 1, 5) = "Test"
--> Anstelle "Test" sollte nun die Spalten unten mit der Formel kopiert werden (Leider kann ich so nur den Text einfügen)
---------------------------------------------------------
Private Sub CommandButton5_Click()
ThisWorkbook.Activate
Worksheets("Verrechnung").Unprotect "1234"
Dim oRange As Range
Dim aCell As Range
Dim bCell As Range
Dim ws As Worksheet
Dim Gefunden As String
Dim Zeile As Long
Dim i As Long
Dim SN As String
SN = "End"
On Error GoTo Fehler
Set ws = Worksheets("Verrechnung")
Set oRange = ws.Columns(1)
Set aCell = oRange.Find(What:=SN, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
Set bCell = aCell
Gefunden = aCell.Row
Do
Set aCell = oRange.FindNext(after:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
Gefunden = Gefunden & ", " & aCell.Row
Else
Exit Do
End If
Loop
Else
MsgBox SN & " nicht gefunden"
Exit Sub
End If
For i = 1 To 5
Zeile = Right(Gefunden, 3)
Rows(Zeile - 1).Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A" & Zeile).Copy
Range("A" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("B" & Zeile).Copy
Range("B" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("J" & Zeile).Copy
Range("J" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("K" & Zeile).Copy
Range("K" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("L" & Zeile).Copy
Range("L" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("M" & Zeile).Copy
Range("M" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("Q" & Zeile).Copy
Range("Q" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("R" & Zeile).Copy
Range("R" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("S" & Zeile).Copy
Range("S" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("T" & Zeile).Copy
Range("T" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("V" & Zeile).Copy
Range("V" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("W" & Zeile).Copy
Range("W" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("X" & Zeile).Copy
Range("X" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("Y" & Zeile).Copy
Range("Y" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("Z" & Zeile).Copy
Range("Z" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("AA" & Zeile).Copy
Range("AA" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("AB" & Zeile).Copy
Range("AB" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("AC" & Zeile).Copy
Range("AC" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("AD" & Zeile).Copy
Range("AD" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("AE" & Zeile).Copy
Range("AE" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("AF" & Zeile).Copy
Range("AF" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("AG" & Zeile).Copy
Range("AG" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("AH" & Zeile).Copy
Range("AH" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("AI" & Zeile).Copy
Range("AI" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("AJ" & Zeile).Copy
Range("AJ" & Zeile - 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Next
Exit Sub
Fehler:
MsgBox Err.Description
End Sub
