vba to add and name worksheets

  • Thread starter Thread starter goss
  • Start date Start date
G

goss

Hi ng
using xl xp pro

Recorded some code to add and rename worksheets to new wb

Sub Xtract()

Application.DisplayAlerts = False
Workbooks.Add
ChDir "C:\WINDOWS\Temp"
With ActiveWorkbook
..SaveAs Filename:="C:\WINDOWS\Temp\my_Labor_Data.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="",
_
ReadOnlyRecommended:=False, CreateBackup:=False

Sheets.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "schedule_dat"

Sheets("Sheet2").Select
Sheets("Sheet2").Name = "actual_dat"

Sheets("Sheet3").Select
Sheets("Sheet3").Name = "budget_dat"
..Close
End With
Application.DisplayAlerts = True


End Sub
=================================

Execution stops after sheet 2.
wb now has 2 sheets with names as coded
sheet 3 is highlighted by debugger
unclear as to why
 
It looks to me as though you have a default workbook of 1 worksheet. Your
code only adds 1, so it fails on 3 if I am correct.

Try this code instead (not tested)

Sub Xtract()
Dim iSheets As Long

Application.DisplayAlerts = False

Workbooks.Add

If Worksheets.Count < 3 Then
For iSheets = Worksheets.Count + 1 To 3
Sheets.Add
Next iSheets
End If

Sheets("Sheet1").Name = "schedule_dat"

Sheets("Sheet2").Name = "actual_dat"

Sheets("Sheet3").Name = "budget_dat"

ChDir "C:\WINDOWS\Temp"
With ActiveWorkbook
..SaveAs Filename:="C:\WINDOWS\Temp\my_Labor_Data.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False


..Close
End With
Application.DisplayAlerts = True


End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
-----Original Message-----
Hi ng
using xl xp pro

Recorded some code to add and rename worksheets to new wb

Sub Xtract()

Application.DisplayAlerts = False
Workbooks.Add
ChDir "C:\WINDOWS\Temp"
With ActiveWorkbook
.SaveAs Filename:="C:\WINDOWS\Temp\my_Labor_Data.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="",
_
ReadOnlyRecommended:=False, CreateBackup:=False

Sheets.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "schedule_dat"

Sheets("Sheet2").Select
Sheets("Sheet2").Name = "actual_dat"

Sheets("Sheet3").Select
Sheets("Sheet3").Name = "budget_dat"
.Close
End With
Application.DisplayAlerts = True


End Sub
=================================

Execution stops after sheet 2.
wb now has 2 sheets with names as coded
sheet 3 is highlighted by debugger
unclear as to why
Click to expand...

Maybe I'm missing something, but assuming you started with
only one sheet, you only call the Add method once, so now
you have two sheets - so of course the code will not
recognize Sheet3. Do another Sheets.Add before the Sheets
("Sheet3").Select
 
Just another idea to this theme might be something like this.

Sub Demo()
Dim Remember
With Application
Remember = .SheetsInNewWorkbook
.SheetsInNewWorkbook = 3
Workbooks.Add
' Reset
.SheetsInNewWorkbook = Remember
End With

Sheets(1).Name = "Schedule_dat"
Sheets(2).Name = "Actual_dat"
Sheets(3).Name = "Budget_dat"
End Sub


PS. You may not want to save any important files in "C:\WINDOWS\Temp..."

--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


Bob Phillips said:
It looks to me as though you have a default workbook of 1 worksheet. Your
code only adds 1, so it fails on 3 if I am correct.

Try this code instead (not tested)

Sub Xtract()
Dim iSheets As Long

Application.DisplayAlerts = False

Workbooks.Add

If Worksheets.Count < 3 Then
For iSheets = Worksheets.Count + 1 To 3
Sheets.Add
Next iSheets
End If

Sheets("Sheet1").Name = "schedule_dat"

Sheets("Sheet2").Name = "actual_dat"

Sheets("Sheet3").Name = "budget_dat"

ChDir "C:\WINDOWS\Temp"
With ActiveWorkbook
.SaveAs Filename:="C:\WINDOWS\Temp\my_Labor_Data.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False


.Close
End With
Application.DisplayAlerts = True


End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
Click to expand...
 
Back
Top