Excel doc. opslaan_als maar orgineel bewaren

[cryptofreak1]

Hallo, ik het een Excel document met 3 Tabbladen erin.
nu kan ik in het eerste tabblad diversen gegeven invullen en die worden verwekt over de andere 3 tabbladen.

nu wil ik met een knop het bestand opslaan_als en daarna het orginele document bewaren zoals hij was.

dus in het kort tabblad 1 invullen dan op knop klikken dan word hij opgeslagen als ik ga weer terug naar mijn begin bestand en hij maakt hem leeg.

ik heb nu deze code gebruikt om hem op te slaan, en het originele bestand leeg te gooien maar het werkt niet.
hij slaat het document wel op maar hij maakt ook gelijk het nieuwe document leeg?????
wie kan mij helpen

Sub Opslaan()


'*********************************
'Opslaan in de map RegistratieSTP
'*********************************


    ChDir "C:\RegistratieSTP"
    
    Sheets("oppotlijst").Select
    teelt = Range("k2")
    week = Range("k4")
    cont = Range("K6")

    ActiveWorkbook.SaveAs Filename:= _
    "C:\RegistratieSTP\" & week & " " & teelt & " " & cont & ".xlsm", _
    FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

    MsgBox "Het document is gemaakt"
    
'***********************************************************************
'Velden Leegmaken
'***********************************************************************

    Range("A6:N42").Select
    Range("F17").Activate
    Selection.ClearContents
    Range("A5").Select
    
End Sub

 

[gast0660]

Probeer het eens zo:

Private Sub CommandButton1_Click()
 ChDir "C:\RegistratieSTP"
    Sheets("oppotlijst").Select
    teelt = Range("k2")
    week = Range("k4")
    cont = Range("K6")
    ActiveWorkbook.SaveCopyAs Filename:= _
    "C:\RegistratieSTP\" & week & " " & teelt & " " & cont & ".xlsm"
    MsgBox "Het document is gemaakt", vbInformation, "Opgeslagen"
    Range("A6:N42").Select
    Selection.ClearContents
    Range("A5").Activate
End Sub

 

[cryptofreak1]

Dit werkt uitstekend alleen in het document wat is opgeslagen, daar is ook de knop opgeslagen.

is daar ook een maniertje op om die niet mee op te slaan?

 

[HSV]

Is het dezelfde knop waar je ook op drukt?
Plaats anders een voorbeeldbestand, kunnen we eea zien hoe het eruit ziet.

Private Sub CommandButton1_Click()
   with Sheets("oppotlijst")
   
    ActiveWorkbook.SaveCopyAs "C:\RegistratieSTP\" & .range("k4") & " " & .range("k2") & " " & .range("k6") & ".xlsm"
    MsgBox "Het document is gemaakt", vbInformation, "Opgeslagen"
      .Range("A6:N42").ClearContents
      .Range("A5").Activate
      .Shapes(1).Delete
 end with
End Sub

 

[cryptofreak1]

ik heb het geprobeerd maar de knop blijft staan en de afbelding die erin moet blijven word verwijderd.

hier heb je het voorbeeld document.

ik het de nieuwe macro onder de map invoer staan

en de oude Macro die ook werkt daar heb ik even in een Module geplakt.


Voorbeeld bestand: Bekijk bijlage I00058.xlsm

 

[HSV]

Probeer het zo maar eens.

Private Sub CommandButton1_Click()
wb = "C:\RegistratieSTP\" & Range("A6") & "_" & Range("B2") & "_" & Range("H6") & ".xlsm"
ThisWorkbook.SaveCopyAs wb
  With getobject(wb)
   .Sheets("invoer").OLEObjects(1).Delete
   .Close -1
  End With
  Range("A6:N42").ClearContents
  Range("A5").Activate
 MsgBox "Het document is gemaakt", vbInformation, "Opgeslagen"
End Sub

 

[cryptofreak1]

Harry helemaal TOP echt het werkt als de beste!!!!

Hiervoor alvast dank!

dan had ik nog 1 klein dingetje,
hoe kan ik in dit zelfde document het tabblad (Kwaliteitscontrole) opslaan als alleen dat tabblad en dat hij alle auto invul waardes overneemt
als alleen Waarde.

heb jij hier iets voor Harry

 

[HSV]

Zoiets?

Het wordt opgeslagen met de datum van vandaag in de formaat "ddmmjjjj", als .xlsx met alleen de waarden.

Private Sub CommandButton1_Click()
wb = "C:\RegistratieSTP\" & Range("A6") & "_" & Range("B2") & "_" & Range("H6") & Right(ThisWorkbook.FullName, 5)
ThisWorkbook.SaveCopyAs wb
  With GetObject(wb)
   .Sheets("invoer").OLEObjects(1).Delete
   .Close -1
  End With
     Range("A6:N42").ClearContents
     Range("A5").Activate
  Sheets("kwaliteitscontrole").Copy
    With ActiveWorkbook.Sheets("kwaliteitscontrole")
      .UsedRange.Value = .UsedRange.Value
      .SaveAs [COLOR=#3E3E3E]"C:\RegistratieSTP\"[/COLOR] & Format(Date, "ddmmyyyy") & ".xlsx", 51
      .Parent.Close
    End With
 MsgBox "Het document is gemaakt", vbInformation, "Opgeslagen"
End Sub

 

[cryptofreak1]

Harry

de macro doet het niet goed als ik op de knop druk komen er wel 2 documenten uit.
maar doc. 1 heeft wel een goede naam maar is leeg

en is het mogelijk om het Sheet de zelfde naam te geven als het totale document maar dat hij hem dan in een andere map zet?

ik zal het nieuwe document erbij doen:

Bekijk bijlage I00058 B.xlsm

 

[HSV]

De structuur van mappen kun je zelf aanpassen door het blauwe gedeelte te wijzigen.

Zo beter.

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
sString = Range("A6") & "_" & Range("B2") & "_" & Range("H6")
wb = [COLOR=#3E3E3E]"C:\RegistratieSTP\"[/COLOR] & sString & Right(ThisWorkbook.FullName, 5)
ThisWorkbook.SaveCopyAs wb
  With Workbooks.Open(wb)
   .Sheets("invoer").OLEObjects(1).Delete
   .Close -1
  End With
     Range("A6:N42").ClearContents
     Range("A5").Activate
  Sheets("kwaliteitscontrole").Copy
    With ActiveWorkbook.Sheets("kwaliteitscontrole")
      .UsedRange.Value = .UsedRange.Value
      .SaveAs [COLOR=#0000ff]"C:\RegistratieSTP\mijn map\"[/COLOR] & sString & ".xlsx", 51
      .Parent.Close
    End With
 MsgBox "Het document is gemaakt", vbInformation, "Opgeslagen"
End Sub

 

[cryptofreak1]

Harry hij werkt echt top :thumb::thumb:

ik heb een klein aanpassing moeten doen want op de manier zoals jij het had beschreven, maakte hij het kwaliteitsrapport maar dat was dat leeg.

ik heb er dit van gemaakt en het werk perfect.

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
sString = Range("A6") & "_" & Range("B2") & "_" & Range("H6")
wb = "C:\RegistratieSTP\" & sString & Right(ThisWorkbook.FullName, 5)
ThisWorkbook.SaveCopyAs wb
With Workbooks.Open(wb)
.Sheets("invoer").OLEObjects(1).Delete
.Close -1
End With
Sheets("kwaliteitscontrole").Copy
With ActiveWorkbook.Sheets("kwaliteitscontrole")
.UsedRange.Value = .UsedRange.Value
.SaveAs "C:\RegistratieSTP\1e kwaliteit controle\" & sString & ".xlsx", 51
.Parent.Close
End With
Range("A6:N42").ClearContents
Range("A5").Activate
MsgBox "Het document is gemaakt", vbInformation, "Opgeslagen"
End Sub

Nogmaals bedankt voor je tijd echt top:thumb::thumb:

Gr Reinier