Create Copies of Workbook with Sheet2 Formulas Referencing Sheet1 Not Workbook Copied From

BigDawg15

Board Regular
Joined
Apr 23, 2018
Messages
53
Office Version
  1. 2016
Platform
  1. Windows
The following code works to loop through names in Index worksheet and copy Sheet1 and Sheet2 to a new workbook named from Index list. Only problem I cannot decipher is it
is copying the formulas from Sheet2 in the original workbook and they remain linked to original workbook instead of to the workbook they are copied into. Any help is appreciated.

Code:
Sub SaveCopyofWorkbookEDITED()
Dim FilePath As String '
Dim FolderObj As Object '
Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range
 
On Error GoTo LeverageLean
 
Application.DisplayAlerts = False 'Hide Display Alerts
 
FilePath = Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - Len(ActiveWorkbook.Name)) & Format(Date, "YYYY") 'Active Workbook File Path and Current Year Folder
 
Set FolderObj = CreateObject("Scripting.FileSystemObject")
If FolderObj.FolderExists(FilePath) Then 'The Folder has been found
Else: FolderObj.CreateFolder (FilePath) 'The Folder has been created
End If
 
FilePath = FilePath & "\" & Format(Date, "MMMM") 'File Path and Current Month Folder
 
Set FolderObj = CreateObject("Scripting.FileSystemObject")
If FolderObj.FolderExists(FilePath) Then 'The Folder has been found
Else: FolderObj.CreateFolder (FilePath) 'The Folder has been created
End If

Set sh1 = Sheets("Index") 'Edit sheet name
Set sh2 = Sheets("Sheet2") 'Edit sheet name
lr = sh1.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = sh1.Range("A1:A" & lr)
 
 
For Each c In rng
   Sheets("Sheet1").Copy 'Edit sheet name
   Set wb = ActiveWorkbook
  'wb.Sheets(1).Range("A1") = c.Value
   wb.Sheets(1).Range("I19") = c.Value
   sh2.Copy After:=wb.Sheets(1)
 
 
'Application.ActiveWorkbook.SaveAs Filename:=FilePath & "\" & Format(Date, "MM.DD.YYYY") & "_" & Format(Now, "HH.MM") & Right(ActiveWorkbook.FullName, (Len(ActiveWorkbook.FullName) + 1) - InStrRev(ActiveWorkbook.FullName, ".")) 'Save copy to Active Workbook File Path\Current Year\Current Month\Current Date & Time
 Application.ActiveWorkbook.SaveAs Filename:=FilePath & "\" & Format(Date, "MM.DD.YYYY") & Right(ActiveWorkbook.FullName, (Len(ActiveWorkbook.FullName) + 1) - InStrRev(ActiveWorkbook.FullName, ".")) & c.Value & ".xlsx"  'Save copy to Active Workbook File Path\Current Year\Current Month\Current Date & Time

'MsgBox "A copy of this Active Workbook named """ & Format(Date, "MM.DD.YYYY") & Right(ActiveWorkbook.FullName, (Len(ActiveWorkbook.FullName) + 1) - InStrRev(ActiveWorkbook.FullName, ".")) & """ has been saved to the following location:" & vbNewLine & vbNewLine & Left(FilePath, InStr(1, ActiveWorkbook.FullName, ActiveWorkbook.Name) - 1)
 
 Next
Exit Sub
  wb.Close True
 
LeverageLean:
MsgBox (Err.Number & " - " & Err.Description & vbNewLine & vbNewLine & "Don't hesitate to email me: anyone@test.com")
 
End Sub


Thank you in advance,

BigDawg15
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

BigDawg15

Board Regular
Joined
Apr 23, 2018
Messages
53
Office Version
  1. 2016
Platform
  1. Windows
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,846
Messages
5,833,938
Members
430,247
Latest member
w9u5280o

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top