Moving worksheets to new workbook based on name

[oracle_monkey]

Version: 2007

Hello Everyone,

I have a workbook with a "Detail" and "Summary" worksheet. The data in each of these worksheets needs to be split up and grouped into separate tabs based on the value of a specific column (region). Then, the Summary and Detail worksheet for each region needs to be moved into a separate workbook, saved, and emailed.

For example, say I have data for Asia, USA, and Mexico in both the Summary and Detail tab. I need the macro to create 6 tabs, Asia - S, Asia - D, USA - S, USA - D, Mexico - S, Mexico - D. Then I need it to pick out Asia - S and Asia - D and move them to a separate workbook, save it, and email it (and do this same process for all regions).

Currently I have code that will parse the Detail and Summary tabs into separate tabs, such as "AsiaD" and "AsiaS". I also have code that will email the files. The piece I am missing is how to select the detail and summary of each region to move to a new workbook.

http://www.mrexcel.com/forum/excel-...rksheet-based-name-another-open-workbook.html This thread gets close to what I need, but I don't know enough VBA to modify the code for my purposes.

Also, below is the code I currently have to split worksheets into separate workbooks. The problem is, this code will split each worksheet into a separate workbook, but I need it to move 2 worksheets (detail and summary for each region).

{Sub Splitbook()

Dim xPath As String, xWs As Worksheet
Dim olApp As Object  ' Outlook.Application
Dim Msg As Object  ' Outlook.MailItem
Dim wkshtName As String
Dim email As String
Dim cc As String

xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
  ' start Outlook
Set olApp = New Outlook.Application

' Save each worksheet to new workbook
For Each xWs In ThisWorkbook.Sheets
    If xWs.Index > 5 Then
    xWs.Copy
    email = Range("ak2").Value
    cc = Range("al2").Value
    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & "FY16" & "_" & "Reps_Not_Planned_" & xWs.Name & "_" & Format(Date, "mmdd") & ".xlsx"
    Application.ActiveWorkbook.Close False
    wkshtName = xPath & "\" & "FY16" & "_" & "Reps_Not_Planned_" & xWs.Name & "_" & Format(Date, "mmdd") & ".xlsx"
    
   'Send email
    Set Msg = olApp.CreateItem(olMailItem)
    With Msg
      .Display
      .Recipients.Add email
      .cc = cc
      .Subject = "HR Changes Report"
      .Attachments.Add wkshtName
      .Send
    End With
    Else
    End If
    
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub}

Any help is greatly appreciated!