Johanheijkers
Gebruiker
- Lid geworden
- 30 nov 2020
- Berichten
- 33
Hallo allemaal,
ik loop vast bij deze macro hij werk goed alleen slaat hij op zonder de formules mee te nemen en Gedefinieerde namen
in het bestand wat ik aan het maken ben voor mijn werk.
zitten formules en Gedefinieerde namen deze moet hij mee nemen naar het aantal sheets. maar nu krijg ik voor elke naam een vraag en de formules zijn dan weg.
ik hoop dat ik het duidelijk heb uit gelegd anders moet ik kijk om een voorbeeldbestand.
ik loop vast bij deze macro hij werk goed alleen slaat hij op zonder de formules mee te nemen en Gedefinieerde namen
in het bestand wat ik aan het maken ben voor mijn werk.
zitten formules en Gedefinieerde namen deze moet hij mee nemen naar het aantal sheets. maar nu krijg ik voor elke naam een vraag en de formules zijn dan weg.
ik hoop dat ik het duidelijk heb uit gelegd anders moet ik kijk om een voorbeeldbestand.
Code:
Sub aanmaken()
Dim strFileName As Variant
Dim strPath As String
strFileName = Range("O5").Value
strFileName = Application.GetSaveAsFilename(InitialFileName:=strPath & strFileName, _
FileFilter:="Excel Files (*.xlsx), *.xlsx, Excel 2007 Files (*.xlsm), *.xslm", _
FilterIndex:=1, _
Title:="Kies de juiste map en pas eventueel de bestandsnaam aan!")
If strFileName = False Then
MsgBox "Oh oh... je hebt het formulier niet opgeslagen! "
Else
ActiveSheet.Copy
With ActiveWorkbook
.Sheets("template").UsedRange.Value = .Sheets("template").UsedRange.Value
.SaveAs Filename:=strFileName
End With
Dim i As Integer, Str As String, x As Integer
Dim ShNumber As Integer
Application.ScreenUpdating = False
x = Application.InputBox("Aantal bladen aub. Naam wordt automatisch togevoegd.", _
"Voer een getal in", , Type:=1)
For i = Sheets.Count To Sheets.Count + x - 1
Str = Range("L3")
ShNumber = i
On Error Resume Next
Sheets(i).Copy After:=Sheets(i)
ActiveSheet.Name = Str & i
Do While Err.Number <> 0
Err.Clear
ShNumber = ShNumber + 1
ActiveSheet.Name = Str & ShNumber
Loop
[K1] = ShNumber
Next
Sheets("template").Select
ActiveWindow.SelectedSheets.Delete
MsgBox "Gelukt! Opgeslagen als: " & strFileName
End If
End Sub