Sub ContactsFromMails()

    Set contactFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)

    For Each item In Application.ActiveExplorer.Selection

        Set mailCopy = item.Copy
        mailCopy.Move (contactFolder)
        item.Delete

    Next
End Sub