Public Sub Antrag_speichern_test2()
Dim lastrow As Integer
Dim WbkNeuName As Integer
Dim WbkNeu As Workbook
Dim Anfrage As Workbook
Dim Übersicht As Workbook
lastrow = 2
Set Übersicht = Workbooks.Open(Filename:="C:\Users\Desktop\gesamtübersichtMakros")
With Übersicht
With .Sheets(1)
Do While .Cells(lastrow, 1) <> 0
lastrow = lastrow + 1
Loop
WbkNeuName = .Cells(lastrow, 1).Row - 2
End With
.Close (False)
End With
Set Anfrage = Workbooks.Open(Filename:="C:\Users\Desktop\anfrage123")
Anfrage.Sheets(1).Range("B3:B10").Copy
Set WbkNeu = Workbooks.Add
With WbkNeu
With .Sheets(1)
.Range("B3").PasteSpecial
End With
.SaveAs ("C:\Users\Desktop\" & WbkNeuName & ".xlsx")
.Close (False)
End With
Anfrage.Close (False)
End Sub