Hello all,
I need some help with a macro, so if you have a few minutes, please help:
- i have the following macro in a worksheet and what is does is: it opens a workbook "XXX", update the links, copy the sheet "ABC" to a new file, add 7 days to the date found on cell J7, break links and save the new file on desktop.
- return to the original file, copy again the sheet ABC to a new workbook, add 14 to the date in J7, break links and save the new file on desktop.
Everything is working just fine when executed normally, but when i move the code to Personal.xlsB, the resulted dates are not correct.
I suspect that beeing executed fro Personal.xlsb workbook, i should declare some other variables?
Could you please help?
Thank you so much in advance.
This is the code:
Sub TEST()
Dim aLinksArray As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Application.Calculation = xlCalculationManual
Application.Workbooks.Open Filename:="C:\Users\user\xxx.xlsx", UpdateLinks:=True
Application.DisplayAlerts = True
Sheets("ABC").Select
Sheets("ABC").Copy
Range("J7").Value = DateAdd("d", 7, CDate(Range("J7")))
aLinksArray = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
Do Until IsEmpty(aLinksArray)
ActiveWorkbook.BreakLink Name:=aLinksArray(1), Type:=xlLinkTypeExcelLinks
aLinksArray = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Range("I9:I200").Select
Selection.ClearContents
ActiveWorkbook.SaveAs Filename:= _
Environ("userprofile") & "\Desktop\" & Format(Date, "YYMMDD") & "_KW" & Range("G5").Value & ".xlsx"
ActiveWindow.Close
ActiveWorkbook.Sheets("ABC").Select
Sheets("ABC").Copy
Range("J7").Value = DateAdd("d", 14, CDate(Range("J7")))
aLinksArray = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
Do Until IsEmpty(aLinksArray)
ActiveWorkbook.BreakLink Name:=aLinksArray(1), Type:=xlLinkTypeExcelLinks
aLinksArray = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Range("I9:I200").Select
Selection.ClearContents
ActiveWorkbook.SaveAs Filename:= _
Environ("userprofile") & "\Desktop\" & Format(Date, "YYMMDD") & "_KW" & Range("G5").Value & ".xlsx"
ActiveWindow.Close
'Application.ScreenUpdating = True
MsgBox "Files are saved on Desktop."
ActiveWorkbook.Close savechanges:=False
Application.ScreenUpdating = True
End Sub
Bookmarks