VBA to add Save as Function

Hello,

I have below VBA code which moves sheets from active workbook. How to add a code which would open a dialog box allowing me choose Save as.

Sub CopySheet()
    Dim varLinks
    Dim strFileName As String
    strFileName = ActiveWorkbook.Path & ActiveSheet.Range("A1").Value & ActiveSheet.Name & ".xml"
    Sheets(Array("Overview", "Create ", "Edit Assign ", "Request Default", "Assign ", "Assign Cos")).Move ' Creates the new workbook AND DELETES THE OLD SHEET
     
     '=======================================================
     'Sometimes you need to kill the links.  Omit this block if this is not an issue
    varLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
    If IsArray(varLinks) Then
        For i = LBound(varLinks) To UBound(varLinks)
            ActiveWorkbook.BreakLink Name:=varLinks(i), Type:=xlLinkTypeExcelLinks
        Next i
    End If
     'End Link killing code
     '=======================================================
     
    ActiveWorkbook.SaveAs strFileName
    ActiveWorkbook.Close False
    
    
End Sub

Thx.. It is working.. But it is saving file as some unopened format. How to save it in xml format?