Letzte Leere Zelle finden von unten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo.
Danke für die Prompte Antwort.
Ist ein bißchen komplizierter ist es wohl schon denke ich.
Meine Einnahmen Zelle ist immer in der Spalte E. Die Ausgaben in G.
Ich erstelle z.bsp. eine neue Zeile mit A5 für die Nummerierung, C5 fürs Datum , E5 Einnahmen bzw. G5 Ausnahmen - eins geht nur.
Sollte z.Bsp. in der Zeile 30 die Zelle E30 mit dem Wert einer Einnahme stehen, bleibt die Zelle rechts daneben logischerweise frei(G30), da zu diesem Zeitpunkt eine Einnahme eingegeben wurde.
Nächster Eintrag Zeile 35. Dort bleibt die Zelle E35 frei, da ich ihn Zelle G35 eine Ausgabe eingeben möchte. Jedoch ist die vorherige Zelle G30 auch frei und somit springt mein Code soweit hoch, bis er eine gefüllte Zelle der Spalte G findet. Ich möchte bei dieser Eintragung aber die Zelle G35 beschreiben.
Danke

Sub Ausgaben_1() Sheets(1).Range("e3").copy Sheets(1).Range("g3000").End(xlUp).Offset(3, 0).Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets(2).Activate ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Activate Application.CutCopyMode = False Sheets(1).Select Sheets(1).Range("Be45").Select End Sub

Hallo,
hier eine Version die auch berücksichtigt,
wenn Zeilen oder Spalten nicht sichtbar sind. zBsp. bei Gruppierung/Fixierung/Filter

Sub Beispiel()
Dim MaxRow&, MaxCol&
'Beispiel letzte Zeile in Tabelle1 
MaxRow = FindMaxRowOrCol(Tabelle1.UsedRange)
MsgBox "letzte Zeile = '" & MaxRow & "'"

'Beispiel letzte Zeile in 1. Spalte 
MaxRow = FindMaxRowOrCol(Tabelle1.UsedRange.Columns(1))
MsgBox "letzte Zeile in 1. Spalte = '" & MaxRow & "'"

'Beispiel letzte Spalte in 1. Zeile 
MaxRow = FindMaxRowOrCol(Tabelle1.UsedRange.Rows(1), True)
MsgBox "letzte Spalte in 1. Zeile = '" & MaxRow & "'"
End Sub

Function FindMaxRowOrCol(rngBereich As Range, Optional FindColumn As Boolean) As Long
Dim nIndex&, sAdress$
On Error Resume Next
With rngBereich
    If Not FindColumn Then
        For nIndex = 1 To .Columns.Count
            sAdress = .Columns(nIndex).Address(1, 1, xlR1C1, External:=True)
            FindMaxRowOrCol = Application.Max(ExecuteExcel4Macro( _
                "LOOKUP(2,1/(" & sAdress & "<>""""),ROW(" & sAdress & "))"), FindMaxRowOrCol)
        Next
    Else
        For nIndex = 1 To .Rows.Count
            sAdress = .Rows(nIndex).Address(1, 1, xlR1C1, External:=True)
            FindMaxRowOrCol = Application.Max(ExecuteExcel4Macro( _
                "LOOKUP(2,1/(" & sAdress & "<>""""),COLUMN(" & sAdress & "))"), FindMaxRowOrCol)
        Next
    End If
End With
If FindMaxRowOrCol = 0 Then FindMaxRowOrCol = 1
On Error GoTo 0
End Function

Gruß Tino

Sub Ausgaben_1() Dim loLetzteE As Long Dim loLetzteG As Long Dim loLetzte As Long '## letzte belegte Zelle in Spalte E loLetzteE = Sheets(1).Cells(Rows.Count, 5).End(xlUp).Row '## letzte belegte Zelle in Spalte G loLetzteG = Sheets(1).Cells(Rows.Count, 7).End(xlUp).Row '## Größere aus loLetzteE / loLetzteG loLetzte = WorksheetFunction.Max(loLetzteE, loLetzteG) Sheets(1).Range("E3").Copy Sheets(1).Cells(loLetzte, 7).Offset(3, 0).PasteSpecial Paste:=xlValues Sheets(2).Activate ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Activate Application.CutCopyMode = False Sheets(1).Select Sheets(1).Range("Be45").Select End Sub

Sub Ausgaben_1() Sheets(1).Range("em49").copy Sheets(2).Activate Sheets(2).Range("g13423").End(xlUp).Offset(3, 0).Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Sheets(1).Select Sheets(1).Range("Be45").Select End Sub

Sub Ausgaben() Dim loLetzteE As Long Dim loLetzteG As Long Dim loLetzte As Long '## letzte belegte Zelle in Spalte E loLetzteE = Sheets(2).Cells(Rows.Count, 9).End(xlUp).Row '## letzte belegte Zelle in Spalte G loLetzteG = Sheets(2).Cells(Rows.Count, 35).End(xlUp).Row '## Größere aus loLetzteE / loLetzteG loLetzte = WorksheetFunction.Max(loLetzteE, loLetzteG) Sheets(1).Range("Em49:ex51").copy Sheets(1).Range("dq3000").End(xlUp).Offset(3, 0).Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets(2).Activate Sheets(2).Cells(loLetzte, 35).Offset(0, 0).PasteSpecial Paste:=xlValues Application.CutCopyMode = False Sheets(1).Select Sheets(1).Range("Be45").Select End Sub

Beliebteste Forumthreads (12 Monate)

Letzte Leere Zelle finden von unten

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

324 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Letzte Leere Zelle finden von unten

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

324 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread