Move Multiple Sheets - Name Variable
 

Hi-

I am trying to create a macro that will generate multiple sheets and then
move them all to a new book. The sheet names are variable based on entries
in a particulatar column. I have a million other questions,but I am very
very new to VB code so I need to keep it simple. I'll learn one thing at
time.

The 'Strategic Goals' tab has a list of names and I am trying to generate
statements for each person. The statement tab is generated with the name of
the person as the name of the tab.

Sub Statement_Generator()

Sheets("Monthly Statement").Copy After:=Sheets(Sheets.Count)
Range("C5").Select
ActiveCell.FormulaR1C1 = "='Strategic Goals'!R[-3]C[-2]"
ActiveSheet.Name = ActiveCell.Text


Sheets("Monthly Statement").Copy After:=Sheets(Sheets.Count)
Range("C5").Select
ActiveCell.FormulaR1C1 = "='Strategic Goals'!R[-2]C[-2]"
ActiveSheet.Name = ActiveCell.Text

End Sub

Move Multiple Sheets - Name Variable
 

So the names of the people (and sheetnames, too) are in a worksheet named
"Strategic goals" in column A?

And you want to create a new workbook with separate worksheets for each of these
people based on the worksheet "monthly statement".

So each workbook is almost identical--except for the name in C5 and the name of
the sheet?

If yes:

Option Explicit
Sub Statement_Generator2()

Dim NameRng As Range
Dim myCell As Range
Dim StmtWks As Worksheet
Dim NameWks As Worksheet
Dim NewWkbk As Workbook
Dim wks As Worksheet

Set NameWks = ThisWorkbook.Worksheets("strategic goals")
Set StmtWks = ThisWorkbook.Worksheets("Monthly Statement")

With NameWks
'identify the range where the names are
'headers in row 1, names are contiguous until the you run out
Set NameRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

Set NewWkbk = Workbooks.Add(1) 'single sheet
NewWkbk.Worksheets(1).Name = "deletemelater"

For Each myCell In NameRng.Cells
StmtWks.Copy _
after:=NewWkbk.Sheets(NewWkbk.Sheets.Count)

Set wks = ActiveSheet 'the one just copied
wks.Range("C5").Value = myCell.Value
On Error Resume Next
wks.Name = myCell.Value
If Err.Number < 0 Then
MsgBox "Rename " & wks.Name & " manually" & _
vbLf & myCell.Value & " not a good name."
Err.Clear
End If
On Error GoTo 0
Next myCell

Application.DisplayAlerts = False
NewWkbk.Worksheets("deletemelater").Delete
Application.DisplayAlerts = True

End Sub


jackie wrote:

Hi-

I am trying to create a macro that will generate multiple sheets and then
move them all to a new book. The sheet names are variable based on entries
in a particulatar column. I have a million other questions,but I am very
very new to VB code so I need to keep it simple. I'll learn one thing at
time.

The 'Strategic Goals' tab has a list of names and I am trying to generate
statements for each person. The statement tab is generated with the name of
the person as the name of the tab.

Sub Statement_Generator()

Sheets("Monthly Statement").Copy After:=Sheets(Sheets.Count)
Range("C5").Select
ActiveCell.FormulaR1C1 = "='Strategic Goals'!R[-3]C[-2]"
ActiveSheet.Name = ActiveCell.Text


Sheets("Monthly Statement").Copy After:=Sheets(Sheets.Count)
Range("C5").Select
ActiveCell.FormulaR1C1 = "='Strategic Goals'!R[-2]C[-2]"
ActiveSheet.Name = ActiveCell.Text

End Sub

--

Dave Peterson

Move Multiple Sheets - Name Variable
 

Thank you.

"Dave Peterson" wrote:

So the names of the people (and sheetnames, too) are in a worksheet named
"Strategic goals" in column A?

And you want to create a new workbook with separate worksheets for each of these
people based on the worksheet "monthly statement".

So each workbook is almost identical--except for the name in C5 and the name of
the sheet?

If yes:

Option Explicit
Sub Statement_Generator2()

Dim NameRng As Range
Dim myCell As Range
Dim StmtWks As Worksheet
Dim NameWks As Worksheet
Dim NewWkbk As Workbook
Dim wks As Worksheet

Set NameWks = ThisWorkbook.Worksheets("strategic goals")
Set StmtWks = ThisWorkbook.Worksheets("Monthly Statement")

With NameWks
'identify the range where the names are
'headers in row 1, names are contiguous until the you run out
Set NameRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

Set NewWkbk = Workbooks.Add(1) 'single sheet
NewWkbk.Worksheets(1).Name = "deletemelater"

For Each myCell In NameRng.Cells
StmtWks.Copy _
after:=NewWkbk.Sheets(NewWkbk.Sheets.Count)

Set wks = ActiveSheet 'the one just copied
wks.Range("C5").Value = myCell.Value
On Error Resume Next
wks.Name = myCell.Value
If Err.Number < 0 Then
MsgBox "Rename " & wks.Name & " manually" & _
vbLf & myCell.Value & " not a good name."
Err.Clear
End If
On Error GoTo 0
Next myCell

Application.DisplayAlerts = False
NewWkbk.Worksheets("deletemelater").Delete
Application.DisplayAlerts = True

End Sub


jackie wrote:

Hi-

I am trying to create a macro that will generate multiple sheets and then
move them all to a new book. The sheet names are variable based on entries
in a particulatar column. I have a million other questions,but I am very
very new to VB code so I need to keep it simple. I'll learn one thing at
time.

The 'Strategic Goals' tab has a list of names and I am trying to generate
statements for each person. The statement tab is generated with the name of
the person as the name of the tab.

Sub Statement_Generator()

Sheets("Monthly Statement").Copy After:=Sheets(Sheets.Count)
Range("C5").Select
ActiveCell.FormulaR1C1 = "='Strategic Goals'!R[-3]C[-2]"
ActiveSheet.Name = ActiveCell.Text


Sheets("Monthly Statement").Copy After:=Sheets(Sheets.Count)
Range("C5").Select
ActiveCell.FormulaR1C1 = "='Strategic Goals'!R[-2]C[-2]"
ActiveSheet.Name = ActiveCell.Text

End Sub

--

Dave Peterson