PDA

View Full Version : copy sheet to workbook; with new sheet name



raylward102
11-20-2010, 12:18 PM
just like it says; I want to check and see if a file exists. If not; then I want to create it and copy a sheet named user into the workbook with a new name for the sheet. IF the workbook exists; I want to do the same..copy sheet and rename. here is the code that I've got so far. It errors.

this part is in a module.

Public Function FileFolderExists(strFullPath As String) As Boolean
On Error GoTo EarlyExit
If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
EarlyExit:
On Error GoTo 0
End Function

this part is in my userform


Private Sub CommandButton11_Click()
If ComboBox5.Text = "" Then
Exit Sub
End If
Dim Filenamed As String
Dim fpath As String
Dim owb As Excel.Workbook
fpath = "c:\CT"
Filenamed = ComboBox5.Text & ".xls"
If FileFolderExists(fpath) Then
'MsgBox "Folder exists!"
Else
MkDir (fpath)

' MsgBox "Folder does not exist!"
End If
If FileFolderExists(fpath & "\" & Filenamed) Then
'MsgBox "File exists!"
Workbooks.Open (fpath & "\" & Filenamed)
'Workbooks.Open filename:=fpath & "\" & Filenamed
Sheets("user").Copy Before:=Workbooks(Filenamed).Sheets(1)
Workbooks(Filenamed).Close SaveChanges:=True
Else
'MsgBox "File does not exist!"
Set NewBook = Workbooks.Add
With NewBook
.Title = ComboBox5.Text
.Subject = ComboBox5.Text
.SaveAs filename:=fpath & "\" & Filenamed
Sheets("user").Copy Before:=Workbooks(Filenamed).Sheets(1)
Workbooks(Filenamed).Close SaveChanges:=True
End With
End If
End Sub

Bob Phillips
11-20-2010, 12:35 PM
Errors where? What works, what doesn't?

raylward102
11-20-2010, 12:52 PM
Stops at this line....error subscript out of range?


Sheets("user").Copy Before:=Workbooks(Filenamed).Sheets(1)

Bob Phillips
11-20-2010, 12:59 PM
Do you have a worksheet called user?

raylward102
11-20-2010, 01:01 PM
yes..... For sure I do.

Aussiebear
11-20-2010, 05:26 PM
What about a workbook named "Filename"?