Copy worksheet problem

[waldermort]

I have a simple function contained within an AciveX dll. Basically I want to copy an existing worksheet to the same workbook, and change the name. Here is the function

Public Function AddSheetCopy(CopyName As String, NewName As String)
    For Each xlSheet In xlApp.worksheets
        If xlSheet.Name = NewName Then
            MsgBox ("sheet exists")
            Exit Function
        End If
    Next xlSheet
    MsgBox (xlApp.worksheets(1).Name)
    xlApp.worksheets(CopyName).Copy after:=xlApp.worksheets(xlApp.worksheets.Count)
    xlApp.activesheet.Name = NewName
    Set xlSheet = xlApp.activesheet
End Function

The above function does exactly as I intend it to do, with one problem. Above there is a message box which displays the name of the first sheet, I don't really want to be plagued with this every time I call the function (I placed it there for debugging). If I comment out that line, the function fails. Instead of making a copy of "copyname" it makes a copy of the current active sheet. I have tries just about everything I can think of to make it work, yet it still doesn't.

Any ideas? thanks in advance.

[DKenny]

Does XlApp refer to the application or to an individual workbook? If it is the Application, then you will need to specify a workbook.

[DKenny]

Here's how I would do it.
BTW, I'm not sure why you have this coded as a Function rather than a Sub, as it doesn't have a return value.

Public Sub AddSheetCopy(CopyName As String, NewName As String)
Dim wksSheet As Worksheet
Dim bExists As Boolean
    
    'step 1 Check if the sheet exists
    For Each wksSheet In ThisWorkbook.Worksheets
        If UCase(wksSheet.Name) = UCase(CopyName) Then
            bExists = True
            Exit For
        End If
    Next wksSheet
    
    'step 2 If it doesn't exist then exit sub
    If Not bExists Then Exit Sub
    
    'step 3 Copy the sheet
    ThisWorkbook.Worksheets(CopyName).Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    Set wksSheet = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    wksSheet.Name = NewName
    
    Set wksSheet = Nothing
End Sub

[DKenny]

In the above example I'm using ThisWorkbook, you will probably need to change that.

[Comintern]

I've found that Excel treats me a lot better when I use explicit references instead of using the Active* objects and the Application collections. Try setting the Workbook explicitly:

Public Function AddSheetCopy(CopyName As String, NewName As String)
 
    Dim xlBook As Excel.Workbook, xlSource As Excel.Worksheet
 
    Set xlBook = xlApp.ActiveWorkbook                           'Get the current book.
    
    For Each xlSheet In xlBook.Worksheets                       'Make sure the NewName doesn't exist.
        If xlSheet.Name = NewName Then
            Debug.Print ("sheet exists")
            Exit Function
        End If
    Next xlSheet
    
    Set xlSource = xlBook.Worksheets(CopyName)                  'Get a ref to the source sheet.
    Call xlSource.Copy(, xlBook.Worksheets(xlBook.Worksheets.Count))    'Copy it.
    
    Set xlSheet = xlBook.Worksheets(xlBook.Worksheets.Count)    'Get a ref to the new copy.
    xlSheet.Name = NewName                                      'Name it.
    
    Set xlBook = Nothing
    Set xlSource = Nothing
 
End Function

Also, instead of just exiting if the CopyName is a duplicate, you can use this function to generate a garunteed unique name. It should always allow a rename to succeed if passed through it. You use something other than V.#, like Copy # of [Sheet], but the principle would be the same.

Public Function UniqueName(xlBook As Excel.Workbook, sName As String) As String
 
    Dim sTest As String, lCount As Long, lNum As Long, lTop As Long, bDuped As Boolean
    
    lTop = xlBook.Worksheets.Count                  'Get the number of sheets in the book.
    If lTop = 1 Then                                'One sheet, can't be a duplicate.
        UniqueName = sName                          'Return it.
        Exit Function
    End If
    
    sTest = sName                                   'Set the testing name to the passed arg.
    Do
        bDuped = False                              'Reset the duplicated flag.
        For lCount = 1 To lTop                      'Test the name against all sheets.
            If xlBook.Worksheets(lCount).Name = sTest Then
                bDuped = True                       'If it's found, set the flag.
            End If
        Next lCount
        If bDuped = True Then
            sTest = sName & " V." & CStr(lNum + 2)  'Try V.#
            lNum = lNum + 1                         'Increment the number counter.
        End If
    Loop Until bDuped = False                       'Loop until it's unique.
 
    UniqueName = sTest
 
End Function

It's called like this:

xlSheet.Name = UniqueName(xlSheet.Parent, NewName)

[waldermort]

Hats of to you, you really know your stuff. Thankyou I have it working now thanks to your example.

I am really more of a C kinda guy, never really coded any VB before the last few days. At the moment I am learning from the examples spread over the web, most of which I have found to be quite confusing.

Thanks again