Hi,
I have a running macro (lets call this Macro 1) which will create multiple sheets based on a template and range in a different sheet. This is working fine within the source file. I usually run Macro 1 and save the file and then move the new sheets to another file and break the links using another macro (Macro 2).
I'm trying to find a way to combine both macros, create new sheets based on the range, move new sheets to new file and break the links.
This is Macro 1
Sub CreateAndNameWorksheets()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Sheets("Codes").Range("A2:A" & Sheets("Codes").Range("A" & Rows.Count).End(xlUp).Row)
Sheets("Template").Range("A1") = c
Sheets("Template").Copy After:=Sheets(Sheets.Count)
With c
ActiveSheet.Name = .Value
End With
Next c
Application.ScreenUpdating = True
End Sub
Macro 2
Sub copySheet()
Dim folderPath As String
folderPath = Application.ActiveWorkbook.Path
Dim Actsheet As String
Application.ScreenUpdating = False
On Error Resume Next
ActiveWindow.SelectedSheets.Copy
ActNm = ActiveSheet.Name
Sheets(ActiveSheet.Name).Visible = True
Set wb = Application.ActiveWorkbook
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
For Each link In wb.LinkSources(xlExcelLinks)
wb.BreakLink link, xlLinkTypeExcelLinks
Next link
End If
Application.ScreenUpdating = True
Application.GetSaveAsFilename
End Sub
Thanks in advance.
I have a running macro (lets call this Macro 1) which will create multiple sheets based on a template and range in a different sheet. This is working fine within the source file. I usually run Macro 1 and save the file and then move the new sheets to another file and break the links using another macro (Macro 2).
I'm trying to find a way to combine both macros, create new sheets based on the range, move new sheets to new file and break the links.
This is Macro 1
Sub CreateAndNameWorksheets()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Sheets("Codes").Range("A2:A" & Sheets("Codes").Range("A" & Rows.Count).End(xlUp).Row)
Sheets("Template").Range("A1") = c
Sheets("Template").Copy After:=Sheets(Sheets.Count)
With c
ActiveSheet.Name = .Value
End With
Next c
Application.ScreenUpdating = True
End Sub
Macro 2
Sub copySheet()
Dim folderPath As String
folderPath = Application.ActiveWorkbook.Path
Dim Actsheet As String
Application.ScreenUpdating = False
On Error Resume Next
ActiveWindow.SelectedSheets.Copy
ActNm = ActiveSheet.Name
Sheets(ActiveSheet.Name).Visible = True
Set wb = Application.ActiveWorkbook
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
For Each link In wb.LinkSources(xlExcelLinks)
wb.BreakLink link, xlLinkTypeExcelLinks
Next link
End If
Application.ScreenUpdating = True
Application.GetSaveAsFilename
End Sub
Thanks in advance.