Hi All!
I'd like your help with the following. Thanks so much, in advance!!
Say I have three worksheets (for three separate individuals)
Each worksheet is named (Last Name, First Name)
I would like to save each worksheet as a new workbook, but instead of naming the workbook the same name as the worksheet, I'd like to name it: Last Name Evaluation Date
(instead of Last Name, First Name)
For Example:
I have 3 Worksheets named:
Doe, John
Russell, Mark
Carson, Kristi
I need 3 separate Workbooks named:
Doe Evaluation Data
Russell Evaluation Data
Carson Evaluation Data
Right now, here is the macro I am using (it creates the workbooks with the names of the worksheets):
___________________________________________________________________________________________
Sub Separate()
'
' Saves each sheet in a new workbook and assigns the Associate name as the filename.
'
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = ActiveWorkbook.Path & "" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' End With
On Error Resume Next '<< a folder exists
MkDir MyFilePath '<< create a folder
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
End With
'save book in this folder
.SaveAs Filename:=MyFilePath _
& "" & SheetName & ".xlsx"
.Close SaveChanges:=True
End With
.CutCopyMode = False
Next
End With
Sheet1.Activate
End Sub
I'd like your help with the following. Thanks so much, in advance!!
Say I have three worksheets (for three separate individuals)
Each worksheet is named (Last Name, First Name)
I would like to save each worksheet as a new workbook, but instead of naming the workbook the same name as the worksheet, I'd like to name it: Last Name Evaluation Date
(instead of Last Name, First Name)
For Example:
I have 3 Worksheets named:
Doe, John
Russell, Mark
Carson, Kristi
I need 3 separate Workbooks named:
Doe Evaluation Data
Russell Evaluation Data
Carson Evaluation Data
Right now, here is the macro I am using (it creates the workbooks with the names of the worksheets):
___________________________________________________________________________________________
Sub Separate()
'
' Saves each sheet in a new workbook and assigns the Associate name as the filename.
'
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = ActiveWorkbook.Path & "" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' End With
On Error Resume Next '<< a folder exists
MkDir MyFilePath '<< create a folder
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
End With
'save book in this folder
.SaveAs Filename:=MyFilePath _
& "" & SheetName & ".xlsx"
.Close SaveChanges:=True
End With
.CutCopyMode = False
Next
End With
Sheet1.Activate
End Sub