Save two tabs as 1 one workbook

[armesca]

I have code which is pasted below which take 8 queries for 4 programs(summary and details tab for each), and saves them all in one excel workbook. I need to also take the summary and details tab for each individual program and save as its own workbook(four total workbooks). Anyone have ideas how to do that in my current code? Thanks..

Private Sub Run_Click()
If IsNull(Me.txt_cfodate) Then
MsgBox "Please Enter A Date!!"
Exit Sub
End If
Dim queryName As String
Dim objExcel As Object
Dim objWB As Object
Dim objWS As Object
Dim myRst As Recordset
Dim mystring As String

'Create an Excel Object
Set objExcel = CreateObject("Excel.Application")
'set our workbook variable to our empty template file
Set objWB = objExcel.Workbooks.Open _
("C:\Documents and Settings\carmes\Desktop\PFSR Templates\AFG_Program_Financial_Status_Rpt_Template_EMPTY.xlsx")

'The following code needs to run for every worksheet that we need to dump data into
Set objWS = objWB.Worksheets("AFG FG Summary")
objExcel.ActiveSheet.Range("A11").Value = "CFO Data as of " & Forms.Form1.txt_cfodate.Value
queryName = "AFG_FG3 - Summary"
Set myRst = Application.CurrentDb.OpenRecordset(queryName)
With objWS
.Range("A3").CopyFromRecordset myRst
.Columns("A").AutoFit
End With
'**************************************
'**************************************
'The following code needs to run for every worksheet that we need to dump data into
Set objWS = objWB.Worksheets("AFG FG Detail")
queryName = "AFG_FG4 - Details"
Set myRst = Application.CurrentDb.OpenRecordset(queryName)
With objWS
.Range("A3").CopyFromRecordset myRst
.Columns("A").AutoFit
End With
'**************************************
'**************************************
'The following code needs to run for every worksheet that we need to dump data into
Set objWS = objWB.Worksheets("AFG FPS Summary")
queryName = "AFG_FPS3 - Summary"
Set myRst = Application.CurrentDb.OpenRecordset(queryName)
With objWS
.Range("A3").CopyFromRecordset myRst
.Columns("A").AutoFit
End With
'**************************************
'**************************************
'The following code needs to run for every worksheet that we need to dump data into
Set objWS = objWB.Worksheets("AFG FPS Detail")
queryName = "AFG_FPS4 - Details"
Set myRst = Application.CurrentDb.OpenRecordset(queryName)
With objWS
.Range("A3").CopyFromRecordset myRst
.Columns("A").AutoFit
End With
'**************************************
'**************************************
'The following code needs to run for every worksheet that we need to dump data into
Set objWS = objWB.Worksheets("AFG SAFER Summary")
queryName = "AFG_SAFER3 - Summary"
Set myRst = Application.CurrentDb.OpenRecordset(queryName)
With objWS
.Range("A3").CopyFromRecordset myRst
.Columns("A").AutoFit
End With
'**************************************
'**************************************
'The following code needs to run for every worksheet that we need to dump data into
Set objWS = objWB.Worksheets("AFG SAFER Detail")
queryName = "AFG_SAFER4 - Details"
Set myRst = Application.CurrentDb.OpenRecordset(queryName)
With objWS
.Range("A3").CopyFromRecordset myRst
.Columns("A").AutoFit
End With
'**************************************
'**************************************
'**************************************
'The following code needs to run for every worksheet that we need to dump data into
Set objWS = objWB.Worksheets("AFG SCG Summary")
queryName = "AFG_SCG3 - Summary"
Set myRst = Application.CurrentDb.OpenRecordset(queryName)
With objWS
.Range("A3").CopyFromRecordset myRst
.Columns("A").AutoFit
End With
'**************************************
'**************************************
'The following code needs to run for every worksheet that we need to dump data into
Set objWS = objWB.Worksheets("AFG SCG Detail")
queryName = "AFG_SCG4 - Details"
Set myRst = Application.CurrentDb.OpenRecordset(queryName)
With objWS
.Range("A3").CopyFromRecordset myRst
.Columns("A").AutoFit
End With
'**************************************

mystring = "C:\Documents and Settings\carmes\Desktop\PFSR Final\AFG_PFSR_" & txt_cfodate

mystring = Replace(mystring, "/", "")
objWB.SaveAs (mystring), FileFormat:=51
objWB.Save
Set objWS = Nothing
Set objWB = Nothing
SetAttr mystring & ".xlsx", vbReadOnly
objExcel.Quit
Set objExcel = Nothing
DoCmd.SetWarnings True