SarahBear
03-31-2016, 12:56 AM
Hi, Newbie here!
I'm really hoping someone can help me with this. I have a basic understanding of VBA but I'm definitely stuck with this one.
The below code works perfectly for what I want it to do at the moment - it creates a copy of a worksheet to a specified folder with a specified name which is determined by formulas on C98 and C99 (on tabs Call 1 - Call 5) of the attached workbook.
However, what I want to do is to create a copy of the entire workbook, using the same formula, and to make sure that the copy is macro-enabled.
I've included all of the code as I'm not entirely sure where I need to start this from but I'm guessing from the section that starts 'ThisWorkbook.Sheets...'
I have googled extensively but nothing I've found seems to quite fit what I want so any help would be greatly appreciated :)
Option Explicit
Sub CreateAgentCopy()
If IsEmpty(Cells(2, 4)) Then
MsgBox "You must complete Agent Name"
ElseIf IsEmpty(Cells(4, 4)) Then
MsgBox "You must complete Team Leader name"
ElseIf IsEmpty(Cells(7, 4)) Then
MsgBox "You must complete Evaluation Date"
Else
Dim NewFn As String
Dim NewWB As Workbook
Dim SubDirectories() As String
Dim i As Integer
Dim SubDirBuild As String
Dim ssh As String
Application.ScreenUpdating = False
ssh = Range("D86").Value
NewFn = Range("D87").Value
SubDirectories = Split(Range("D86"), "\")
'If Directory specified then place at begining of string otherwise
'the current Directory will be used
If Right(SubDirectories(0), 1) = ":" Then SubDirBuild = SubDirectories(0)
'Add each subdirectory to string and try to make a subdirectory
For i = LBound(SubDirectories) + 1 To UBound(SubDirectories)
SubDirBuild = SubDirBuild & "\" & SubDirectories(i)
'MsgBox SubDirBuild
On Error Resume Next
MkDir SubDirBuild
Next i
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ssh & NewFn
Set NewWB = ActiveWorkbook
ThisWorkbook.Sheets("Planning_Form").Copy Before:=NewWB.Sheets("Sheet1")
NewWB.ActiveSheet.Buttons.Visible = False
ActiveWorkbook.Close True
NewWB.Close Savechanges:=True
MsgBox "Copy routine completed"
End If
End Sub
I'm really hoping someone can help me with this. I have a basic understanding of VBA but I'm definitely stuck with this one.
The below code works perfectly for what I want it to do at the moment - it creates a copy of a worksheet to a specified folder with a specified name which is determined by formulas on C98 and C99 (on tabs Call 1 - Call 5) of the attached workbook.
However, what I want to do is to create a copy of the entire workbook, using the same formula, and to make sure that the copy is macro-enabled.
I've included all of the code as I'm not entirely sure where I need to start this from but I'm guessing from the section that starts 'ThisWorkbook.Sheets...'
I have googled extensively but nothing I've found seems to quite fit what I want so any help would be greatly appreciated :)
Option Explicit
Sub CreateAgentCopy()
If IsEmpty(Cells(2, 4)) Then
MsgBox "You must complete Agent Name"
ElseIf IsEmpty(Cells(4, 4)) Then
MsgBox "You must complete Team Leader name"
ElseIf IsEmpty(Cells(7, 4)) Then
MsgBox "You must complete Evaluation Date"
Else
Dim NewFn As String
Dim NewWB As Workbook
Dim SubDirectories() As String
Dim i As Integer
Dim SubDirBuild As String
Dim ssh As String
Application.ScreenUpdating = False
ssh = Range("D86").Value
NewFn = Range("D87").Value
SubDirectories = Split(Range("D86"), "\")
'If Directory specified then place at begining of string otherwise
'the current Directory will be used
If Right(SubDirectories(0), 1) = ":" Then SubDirBuild = SubDirectories(0)
'Add each subdirectory to string and try to make a subdirectory
For i = LBound(SubDirectories) + 1 To UBound(SubDirectories)
SubDirBuild = SubDirBuild & "\" & SubDirectories(i)
'MsgBox SubDirBuild
On Error Resume Next
MkDir SubDirBuild
Next i
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ssh & NewFn
Set NewWB = ActiveWorkbook
ThisWorkbook.Sheets("Planning_Form").Copy Before:=NewWB.Sheets("Sheet1")
NewWB.ActiveSheet.Buttons.Visible = False
ActiveWorkbook.Close True
NewWB.Close Savechanges:=True
MsgBox "Copy routine completed"
End If
End Sub