Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Saving multiple files into same woorbook 2

Status
Not open for further replies.

vba317

Programmer
Mar 5, 2009
708
US
I currently have a database that opens a spreadsheet, puts data on to a sheet than saves the sheet and closes it. It than creates 8 different spreadsheets that I have to manually add to the same spreadsheet. I would like to change this to having the different workbooks save to a different tab in the same notebook. I highlighted in Blue where the code saves the file. I know I would have to remove this code but what would I change it to so I move to a new tab? What is the code to open a new tab and start putting the new data into that new tab? Any help is appreciated.

Tom


Code:
Public goXL As Excel.Application ' The Excel Object variable
Public gbXLPresent As Boolean ' Identifies whether Excel is present upon starting
Public Const gconSaveLocation As String = "\\Amsdc\public\Client Services\Automate\HMF_Rpts\Rpts\" ' Path to save finished workbooks

Public Function XLCreate()

' ************************************************
' *** THIS SUB CREATES A NEW INSTANCE OF EXCEL ***
' ************************************************
On Error Resume Next
gbXLPresent = True
Set goXL = CreateObject("Excel.Application")
If goXL Is Nothing Then ' Check if Excel is installed
    gbXLPresent = False
Else
    goXL.Visible = True ' If there, make it visible
End If

End Function




' Open Excel
Call XLCreate
' Total Procedures
strSQL = "SELECT [_Periods].monord,[_Periods].yr,tbl_RptData.RefProvider,tbl_RptData.refgrp,Sum(tbl_RptData.Unit) AS u " & _
            "FROM tbl_RptData INNER JOIN _Periods ON tbl_RptData.BillMonth = [_Periods].BillMonth " & _
            "GROUP BY [_Periods].monord,[_Periods].yr,tbl_RptData.RefProvider,tbl_RptData.refgrp " & _
            "HAVING [_Periods].monord <> 0 And [_Periods].yr > '2011' And Sum(tbl_RptData.Unit) <> 0 " & _
            "ORDER BY tbl_RptData.RefProvider,[_Periods].monord;"
Set rst = CurrentDb.OpenRecordset(strSQL, dbopensnapshot)
If Not rst.EOF Then
    With rst
        .MoveLast
        .MoveFirst
    End With
    strSaveName = "\\salmfilesvr1\Public\Client Services\AutoRpts\_RptSets\OTHER\INR\Tools\INR_RefProv_Tot_Proc.xls"
    ' Open Template
    goXL.Workbooks.Open Filename:=strTemplate
    ' Initialize
    iRw = 6
    With goXL.Sheets("RefPhys")
        .Name = "RefProv_Tot_Units"
        .Cells(1, 18) = iNumMon
    End With
    With goXL.ActiveSheet
        .Cells(1, 1).Value = "REFERRING PHYSICIAN REFERRED (Units)"
        .Cells(3, 1).Value = "Fiscal " & (rst![yr])
    End With
    strCurRP = (rst![RefProvider])
    strGrpRP = (rst![RefProvider])
    ' Add Data
    For Z = 1 To rst.RecordCount
        If ((rst![monord]) = 99) Then
            iCol = 17
        Else
            iCol = ((rst![monord]) + 2)
        End If
        With goXL.ActiveSheet
            .Cells(iRw, 1).Value = strCurRP
            .Cells(iRw, 2).Value = (rst![refgrp])
            .Cells(iRw, iCol).Value = (rst![u])
        End With
        rst.MoveNext
        If Not rst.EOF Then
            strCurRP = (rst![RefProvider])
            If (strCurRP <> strGrpRP) Then
                iRw = iRw + 1
                strGrpRP = strCurRP
            End If
        End If
    Next Z
    ' Delete Extra Rows
    With goXL
        .Rows("" & (iRw + 1) & ":1499").Select
        Selection.Delete Shift:=xlUp
        .Cells(4, 1).Select
    End With
    ' Save Report
    With goXL.ActiveWorkbook
[Blue]        .SaveAs Filename:=strSaveName
        .Close  [/Blue]
    End With
End If
rst.Close
Set rst = Nothing

' Total Charges
strSQL = "SELECT [_Periods].monord,[_Periods].yr,tbl_RptData.RefProvider,tbl_RptData.refgrp,Sum(tbl_RptData.Chgs) AS c " & _
            "FROM tbl_RptData INNER JOIN _Periods ON tbl_RptData.BillMonth = [_Periods].BillMonth " & _
            "GROUP BY [_Periods].monord,[_Periods].yr,tbl_RptData.RefProvider,tbl_RptData.refgrp " & _
            "HAVING (([_Periods].monord <> 0) And (Sum(tbl_RptData.Chgs) <> 0)) " & _
            "ORDER BY tbl_RptData.RefProvider,[_Periods].monord;"
Set rst = CurrentDb.OpenRecordset(strSQL, dbopensnapshot)
If Not rst.EOF Then
    With rst
        .MoveLast
        .MoveFirst
    End With
    strSaveName = "\\salmfilesvr1\Public\Client Services\AutoRpts\_RptSets\OTHER\INR\Tools\INR_RefProv_Tot_Chgs.xls"
    ' Open Template
    goXL.Workbooks.Open Filename:=strTemplate
    ' Initialize
    iRw = 6
    With goXL.Sheets("RefPhys")
        .Name = "RefProv_Tot_Chgs"
        .Cells(1, 18) = iNumMon
    End With
    With goXL.ActiveSheet
        .Cells(1, 1).Value = "REFERRING PHYSICIAN REFERRED (Charges)"
        .Cells(3, 1).Value = "Fiscal " & (rst![yr])
    End With
    strCurRP = (rst![RefProvider])
    strGrpRP = (rst![RefProvider])
    ' Add Data
    For Z = 1 To rst.RecordCount
        If ((rst![monord]) = 99) Then
            iCol = 17
        Else
            iCol = ((rst![monord]) + 2)
        End If
        With goXL.ActiveSheet
            .Cells(iRw, 1).Value = strCurRP
            .Cells(iRw, 2).Value = (rst![refgrp])
            .Cells(iRw, iCol).Value = (rst![c])
        End With
        rst.MoveNext
        If Not rst.EOF Then
            strCurRP = (rst![RefProvider])
            If (strCurRP <> strGrpRP) Then
                iRw = iRw + 1
                strGrpRP = strCurRP
            End If
        End If
    Next Z
    ' Delete Extra Rows
    With goXL
        .Rows("" & (iRw + 1) & ":1499").Select
        Selection.Delete Shift:=xlUp
        .Cells(4, 1).Select
    End With
    ' Save Report
    With goXL.ActiveWorkbook
        .SaveAs Filename:=strSaveName
        .Close
    End With
End If
rst.Close
Set rst = Nothing



[\code]
 
What is the code to open a new tab
Use the Sheets.Add method.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
What is the code to open a new tab

When the default workbook opens, it (usually) has 3 worksheets. Do you want to know how to 'move' from Sheet1 to Sheet2? And then to Sheet3?

Or do you want to create a new Sheet, move it to be the last Sheet in the workbook, rename it, and place the data into it?

Have fun.

---- Andy
 
Andy,
In the original template that I have the program open only has one tab. So when I finish doing the calculations for tab 1 I will need to add tab 2, name it than do the calculation so on , and so on.

Tom
 
How about (what PHV suggested):

Code:
[green]
'Add a new Sheet[/green]
Sheets.Add[green]
'Move the new Sheet to be the last one[/green]
Sheets(Sheets.Count - 1).Move After:=Sheets(Sheets.Count)[green]
'Rename it[/green]
Sheets(Sheets.Count).Name = ([blue]"SomeSheetName"[/blue] & Sheets.Count)

Have fun.

---- Andy
 
After combining both Andy's and PHV's method I came up with my solution. Thanks everyone for your help.


Code:
  'Define Template
        strTemplate1 = "\\salmfilesvr1\Public\Client Services\AutoRpts\_RptSets\OTHER\INR\Tools\RefProv.xlt"
        'Add a new Template
        Sheets.Add Type:=strTemplate1
        'New SheetName
        strSheetName = "RefProv_Tot_Chgs"
         'Name Sheet
        With goXL.Sheets(strTemplateSheetName)
            .Name = strSheetName
            .Cells(1, 19) = iNumMon
        End With
         'Move the new Sheet to be the last one
        Sheets(Sheets.Count - 1).Move After:=Sheets(Sheets.Count)
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top