Sub Copy_Sheets()
  Dim strNames As String, strWSName As String
  Dim arrNames, CopyNames
  Dim wbAct As Workbook
  Dim i As Long
  Dim arrlist As Object

  Set arrlist = CreateObject("system.collections.arraylist")
  arrlist.Add "1234"
  arrlist.Add "5678"


  Set wbAct = ActiveWorkbook
  For Each Item In arrlist

  For i = 1 To Sheets.Count
    strNames = strNames & "," & Sheets(i).Name
  Next i
    arrNames = Split(Mid(strNames, 2), ",")

    'strWSName =("1234")
    strWSName = Item

        Application.ScreenUpdating = False
        CopyNames = Filter(arrNames, strWSName, True, vbTextCompare)
        If UBound(CopyNames) > -1 Then
          Sheets(CopyNames).Copy
          ActiveWorkbook.SaveAs Filename:=strWSName & " " & Format(Now, "dd-mmm-yy h-mm-ss")
          ActiveWorkbook.Close
          wbAct.Activate
        Else
          MsgBox "No sheets found: " & strWSName
        End If

    Next Item

        Application.ScreenUpdating = True

End Sub