letzte freie Zelle
25.01.2019 12:44:51
Okan
ich habe folgendes Anliegen:
ich nutze folgende Funktion und würde gerne immer die letzte Zelle finden und diese mit Daten füllen.
Leider funktioniert mein Makro nicht ganz so wie ich es will.
Es überschreibt immer die Zellen A3; B3; C3.
Function IsWorkbookOpen(strWB As String) As Boolean
On Error Resume Next
IsWorkbookOpen = Not Workbooks(strWB) Is Nothing
End Function
Sub NewAdd()
If IsWorkbookOpen("Fehlerprotokoll.xlsx") Then
Workbooks("Fehlerprotokoll.xlsx").Activate
Cells(Range("A1").End(xlDown).Row + 1, 1).Select
ActiveCell.FormulaR1C1 = Now
Cells(Range("A1").End(xlDown).Row + 1, 2).Select
ActiveCell.FormulaR1C1 = "Abteilung"
Cells(Range("A1").End(xlDown).Row + 1, 3).Select
ActiveCell.FormulaR1C1 = "Station"
Else
Set NewBook = Workbooks.Add
With NewBook
.SaveAs Filename:="C:\Users\firato\Desktop\Fehlerprotokoll.xlsx"
Range("A2").Select
ActiveCell.FormulaR1C1 = "Zeit"
Range("B2").Select
ActiveCell.FormulaR1C1 = "Abteilung"
Range("C2").Select
ActiveCell.FormulaR1C1 = "Station"
Range("D2").Select
ActiveCell.FormulaR1C1 = "Checkbox1"
Range("E2").Select
ActiveCell.FormulaR1C1 = "Checkbox2"
Range("F2").Select
ActiveCell.FormulaR1C1 = "Checkbox3"
Cells(Range("A1").End(xlDown).Row + 1, 1).Select
ActiveCell.FormulaR1C1 = Now
Cells(Range("A1").End(xlDown).Row + 1, 2).Select
ActiveCell.FormulaR1C1 = "Abteilung"
Cells(Range("A1").End(xlDown).Row + 1, 3).Select
ActiveCell.FormulaR1C1 = "Station"
End With
End If
End Sub
Ich danke im Voraus schon mal für die Rückmeldungen.
VG
Okan