VBA weggooien na opslaan active werkblad

[Kramer]

Hallo Iedereen,

Ik heb deze code in mijn active werkblad staan

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Address = "$F$21" And Target = 0 Or UCase(Target) = "NIEUW" Then
    Sheets("Adressen").ShowDataForm
End If
With Sheets("Adressen").[A65536].End(xlUp)
    If .Offset(1, 1) <> "" Then
        .Offset(1) = WorksheetFunction.Max(Worksheets("Adressen").Columns(1)) + 1
    End If
End With
End Sub

Werkt zeer goed.

Nu heb ik deze code in een module om het active werkblad op te slaan:

Sub Opslaan()
ActiveWorkbook.Save

Application.EnableEvents = False
Sheets("Factuur of Offerte").Copy
With ActiveWorkbook
         Sheets("Factuur of Offerte").UsedRange.Value = Sheets("Factuur of Offerte").UsedRange.Value
End With

 Dim strFileName As Variant
  Dim strPath As String
  strFileName = Range("N2") & "_" & Range("I11") & "_" & Range("I12").Value
  strFileName = Application.GetSaveAsFilename(InitialFileName:=strPath & strFileName, _
                                              FileFilter:="Excel Files (*.xls), *.xls, 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 niet opgeslagen! "
  Else
    ActiveWorkbook.SaveAs Filename:=strFileName
    MsgBox "Gelukt! Opgeslagen als: " & strFileName
  End If

Application.EnableEvents = True
End Sub

nu komt mijn probleem.

Wanneer ik nu een document open die ik zo heb opgeslagen vraagt hij steeds om macros in- iof uitschakelen. Het blijkt dat hij ook de code van mijn active werkblad meeneemt.

Kan ik in mijn opslaan code het zo regelen dat hij de code in het active werkblad weggooit op het moment dat ik hier een naam aangeef.

Ik hoop dat jullie het snappen zoniet stel vragen dan probeer ik het beter uit te leggen.

Zie ook de bijlage
Bekijk bijlage 115135

 

[Superzeeuw]

Kramer,

In het bijgevoegde programma heb ik de sheet change functie verplaatst naar This Workbook.
Nu kun je namelijk gewoon je tabbladen kopiëren naar een nieuw aangemaakt bestand en dan neem je geen codes mee.

P.s.: Heb de code van leegmaken al aangepast. De rest van de codes kan ook nog aangepakt worden.

 

[Kramer]

codes aangepakt worden

Ten eerste bedankt voor de snelle reactie maar wat bedoel je met:

De rest van de codes kan ook nog aangepakt worden.

Zijn de codes te groot?? Ik wil graag weten wat ik kan verbeteren.

 

[Warme bakkertje]

Dit

Range("N2").Select
      ActiveCell.FormulaR1C1 = "FACTUUR"

kan ook zo

Range("N2") = "FACTUUR"

 

[Kramer]

bedankt

Bedankt, zijn er nog meer dingen die ik kan verbeteren???

 

[Superzeeuw]

Kramer,

Kijk eens naar de code van Procent 0, Procent 6, Procent 19 en de eerste drie regels van Factuur.

 

[Kramer]

Bedankt

Kramer,

Kijk eens naar de code van Procent 0, Procent 6, Procent 19 en de eerste drie regels van Factuur.

Bedankt Superzeeuw. :thumb::thumb: Ga het bestand helemaal aanpassen.