Klar geht das
23.11.2017 02:33:33
CitizenX
Hi,
erstelle dir eine Button und weise ihm den Code zu:
Option Explicit
Private Sub CommandButton1_Click()
Dim lngLast&, n&, myStr$, myCopy$
Dim myCell As Object, oClipBoard As Object
myStr = "F-"
Set oClipBoard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
lngLast = Cells(Rows.Count, 1).End(xlUp).Row
Set myCell = Cells(lngLast, 1)
If InStr(myCell, myStr) Then
n = CLng(Replace(myCell, myStr, 0)) + 1
myCell.Offset(1, 0) = myStr & Format(n, "00000000")
myCell.Offset(1, 1).FormulaR1C1 = "=SUBSTITUTE(RC[-1],""" & myStr & ""","""")"
myCell.Offset(1, 0).Copy
Else
myCell = myStr & Format(n, "00000000")
myCell.Offset(0, 1).FormulaR1C1 = "=SUBSTITUTE(RC[-1],""" & myStr & ""","""")"
myCell.Copy
End If
'Inhalt in Zwischenablage kopieren
With oClipBoard
.GetFromClipboard
myCopy = .GetText
.Clear
.SetText myCopy
.PutInClipboard
End With
ThisWorkbook.Save
End Sub
VG
Steffen