Saving a copy with date problem

Need some help please...
made a buttone with code i found to save a copy with current date for an archive folder. works great!
problem is the changes i do in the worksheet arnt saved in original file. need to save both...

need do either:
- save 2 copys in 2 difrent folders (add another path to the code - FOLDER02)
- write the code so it saves on the original file and a copy to the rchive folder

Any ideas??


This is the code i use:
-----------------------------------

Code:

---

Sub SaveArchive()


Dim dtDate As Date
dtDate = Date


Dim strFile As String
strFile = "C:\Users\shay\Desktop\FOLDER01\FILENAME" & Format(dtDate, " dd.mm.yyyy") & ".xlsm"


ActiveWorkbook.SaveAs Filename:=strFile, FileFormat _
    :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


End Sub

---

--------------------------------------

Make your changes, save it, then run SaveArchive.

Here is the code I use to backup My Personal.xls. It is in the ThisWorkbook module of Personal.xls

Code:

---

Private Const BackUpDrive As String = "E:"
Private Const BackUpFolder As String = "MyPersonal"
Private Const BackUpName As String = "Personal.xls.Bak"

---

Code:

---

Private Sub Workbook_BeforeSave(ByVal SaveAsUi As Boolean, Cancel As Boolean)
  MakeCopyOfPersonal
End Sub

---

Code:

---

Private Sub MakeCopyOfPersonal()
Dim TimeStamp As String
 
  If Len(Dir(BackUpDrive & "\" & BackUpFolder, vbDirectory)) = 0 Then
    MsgBox "Personal xls not backed up. Cannot find the Backup Folder"
    Exit Sub
  End If
 
  TimeStamp = Left(CStr(CDbl(Now)), 10) & "_"
  Me.SaveCopyAs (BackUpDrive & "\" & BackUpFolder & "\" _
              & TimeStamp & BackUpName)

End Sub

---

I don't care about the actual date in the name. I just want the copies in chronological order. You can have the date in chronological order by using the Format String "yyyy-mm-dd".

The Use of Constants and the no back up message is because over the years, I have moved things around and lost backups.

Tnx Sam!! :hi:
Have a great weekend!