Public Sub CopyPage()
    Dim currPage As Visio.Page
    Dim newPage As Visio.Page
    Dim maxNr As Integer
    Dim currBackPage As String
    Dim currPageName As String
    Dim allShapes As Visio.Selection
    Dim groupedShapes As Visio.Shape
    
    ' Group all shapes on the current page and copy them to clipboard
    ActiveWindow.SelectAll
    Set allShapes = ActiveWindow.Selection
    Set groupedShapes = allShapes.Group
    groupedShapes.Copy visCopyPasteNoTranslate
    groupedShapes.Ungroup
    
    ' Create the new page
    Set currPage = ActivePage
    Set newPage = ActiveDocument.Pages.Add
    If Not (currPage.Background) Then
        'if current page is a background page, don't set index
        newPage.Index = currPage.Index + 1
    End If
    
    ' Create a proper name for the new page
    currPageName = currPage.Name
    maxNr = Len(currPageName)
    If (maxNr > 24) Then
        maxNr = 24
    End If
    newPage.Name = Left(currPageName, maxNr) + " (copy)"
    
    'Paste the grouped shapes
    newPage.Paste visCopyPasteNoTranslate
    If newPage.Shapes.Count Then
        newPage.Shapes.Item(1).Ungroup
    End If
    ActiveWindow.DeselectAll
End Sub