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!

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

runtime error 9 trying to copy one worksheet to another workbook 2

Status
Not open for further replies.
vba317

vba317

Programmer
Mar 5, 2009
708
US
Hello,
I am trying to copy one worksheet to another workbook and I keep on getting a run-time error 9. I have both workbooks open and my error is being caused on the line in blue.

Tom

Code: 
'Original routine
'Open Assists Worksheet
    Call CurMonYrS(sUCI, sMon, sCY)
    sFile = "MSP_Assists_" & sMon & sCY
    sFileLoc = "\\salmfilesvr1\public\Client Services\AutoRpts\_RptSets\OTHER\MSP\"
    sSheet = "Assists_All"
    sFileType = ".xls"
    Call xlOpen(sFileLoc, sUCI, sFile, sSheet, sFileType)
  sSQLR = "SELECT D.deltypedsc,FY.uci,FY.mon_shnm," & _
            "FY.fy,I.deltoname,I.prntqid,Pd.mon_txtnum " & _
            "FROM ((dbo_prntq_info I " & _
            "INNER JOIN dbo_rpt_FYInfo FY ON FY.clntid=I.clntid) " & _
            "INNER JOIN dbo_prntq_deltype D ON I.deltype=D.deltypeid) " & _
            "INNER JOIN dbo_dic_Period Pd ON FY.rptpd = Pd.pd " & _
            "WHERE D.deltypedsc='" & "EMAIL'" & " AND FY.uci='" & "MSP'" & " AND FY.rptpddiff=1 " & _
            "ORDER BY I.prntqid;"
    Set rstR = CurrentDb.OpenRecordset(sSQLR, dbOpenSnapshot)
    If Not rstR.EOF Then
        With rstR
            .MoveLast
            .MoveFirst
        End With
        For R = 1 To rstR.RecordCount
            sType = (rstR![deltypedsc])
            sMon = (rstR![mon_shnm])
            sYr = (rstR![fy])
            sRptName = (FixDesc(rstR![deltoname]))
            sRptNum = (rstR![prntqid])
            sMonTxt = (rstR![mon_txtnum])
            '1st report
            '
            sFileLoc = "\\salmfilesvr1\public\Client Services\AutoRpts\_RptSets\SALEM\" & sUCI & "\" & sYr & "\" & sMonTxt & "\"

For R = 1 To rstR.RecordCount
            sType = (rstR![deltypedsc])
            sMon = (rstR![mon_shnm])
            sYr = (rstR![fy])
            sRptName = (FixDesc(rstR![deltoname]))
            sRptNum = (rstR![prntqid])
            sMonTxt = (rstR![mon_txtnum])
            '1st report
            '
            sFileLoc = "\\salmfilesvr1\public\Client Services\AutoRpts\_RptSets\SALEM\" & sUCI & "\" & sYr & "\" & sMonTxt & "\"
            
           
            sReport = sType & "_" & sUCI & "_" & sMon & "_" & sYr & "_" & sRptName & "_" & sRptNum & ".xls"
            sS_WrkBk = sUCI & "_Assists_" & sMon & sYr & ".xls"
            sT_WrkBk = sReport
            sFileType = "Assists_"

 Call xlCopyWorksheets(sFileLoc, sUCI, sS_WrkBk, sT_WrkBk, sS_ShtNm)
        Next R
    End If


Public Function xlOpen(sFileLoc As String, sUCI As String, sFile As String, sSheet As String, sFileType As String)
' *******************************************************
' *** THIS FUNCTION OPENS AN EXCEL TEMPLATE *************
' *******************************************************
'Call xlOpen(sFileLoc, sClient, sFile, sSheet, sFileType)
    Dim dBase As DAO.Database
    Dim sFileExt As String
    Dim sFileOpen As String
    Set dBase = CurrentDb
    'Set on error in case there are no tables
    sFileOpen = sFileLoc & sFile
    On Error Resume Next
    ' OPEN EXCEL
    Call xlCreate
    If goXlPresent = True Then
        'OPEN EXCEL
        With goXl
            .Workbooks.Open FileName:=sFileOpen
            'Select Sheetname for information to go into.
            .Sheets(sSheet).Select
            '.Sheets & "(""& sSheet & "")" & .Select
            .Cells(1, 1).Select
        End With
    End If
End Function

Public Function xlCopyWorksheets(sFileLoc As String, sUCI As String, sS_WrkBk As String, sT_WrkBk As String, sS_ShtNm As String)
    Dim wrkbk As Workbook
    Dim sFileType As String
    'Open destination workbook
    sFileType = "xls"
    Call xlOpen(sFileLoc, sUCI, sT_WrkBk, sS_ShtNm, sFileType)
    Workbooks(sS_WrkBk).Activate
[Blue]    goXl.Workbooks(sS_WrkBk).Sheets(sS_ShtNm).Copy after:=goXl.Workbooks(sT_WrkBk).Sheets(goXl.Workbooks(sT_WrkBk).Sheets.Count) [/Blue]
    'Save active workbook
    goXl.ActiveWorkbook.Save
    'Close Active workbook
    goXl.ActiveWorkbook.Close
End Function
 
Sort by date Sort by votes
Hi,

Code: 
  [highlight #FCE94F]GoXl[/highlight].Workbooks(sS_WrkBk).Activate

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
I have both workbooks open
Are you sure ?
There is NO error trapping in your xlOpen procedure.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Upvote 0 Downvote
OK, I added error trapping to the open procedure. There are no errors but I noticed that the open procedure was selecting a sheet from the Source workbook not the copt to workbook. so I changed the sheet name it was selecting. I added code so the to name what sheet to select from the workbook that is being copied to. I am stepping through the code and so I see that both workbooks are being opened and the correct sheets are being selected. I am still getting a run-time error 9 subscript out of range at the highlighted in blue part. I deleted the activation and select that used to be before the error line.

Tom

Code: 
Public Function xlOpen_copy(sFileLoc As String, sUCI As String, sFile As String, sSheet As String, sFileType As String)
' *******************************************************
' *** THIS FUNCTION OPENS AN EXCEL TEMPLATE *************
' *******************************************************
'Call xlOpen(sFileLoc, sClient, sFile, sSheet, sFileType)
    Dim dBase As DAO.Database
    Dim sFileExt As String
    Dim sFileOpen As String
    Set dBase = CurrentDb
    'Set on error in case there are no tables
[Red]    On Error GoTo Errhandler [/Red]
    sFileOpen = sFileLoc & sFile
      ' OPEN EXCEL
    Call xlCreate
    If goXlPresent = True Then
        'OPEN EXCEL
        With goXl
            .Workbooks.Open FileName:=sFileOpen
            'Select Sheetname for information to go into.
            .Sheets(sSheet).Select
            '.Sheets & "(""& sSheet & "")" & .Select
            .Cells(1, 1).Select
        End With
    End If
    Exit Function
[Red] Errhandler:
    ' Display the error number and the error text.
    MsgBox "Error # " & Err & " : " & Error(Err)  [/Red]
End Function


  '1st report
            '
            sFileLoc = "\\salmfilesvr1\public\Client Services\AutoRpts\_RptSets\SALEM\" & sUCI & "\" & sYr & "\" & sMonTxt & "\"
            
           
            sReport = sType & "_" & sUCI & "_" & sMon & "_" & sYr & "_" & sRptName & "_" & sRptNum & ".xls"
            sS_WrkBk = sUCI & "_Assists_" & sMon & sYr & ".xls"
            sT_WrkBk = sReport
            sFileType = "Assists_"
[Red]            Select Case sRptNum
            
            Case 169
            sS_ShtNm = sFileType & "_NENA"
            sT_ShtNm = "CPTDet_PRV_NENA" 
            
            'If sRptNum = 169 Then sS_ShtNm = sFileType & "_NENA", sT_ShtNm = "CPTDet_PRV_NENA"
'            If sRptNum = 548 Then sS_ShtNm = sFileType & "_NESG"
'            If sRptNum = 549 Then sS_ShtNm = sFileType & "_Castrillion"
'            If sRptNum = 560 Then sS_ShtNm = sFileType & "_Combined"
'            If sRptNum = 582 Then sS_ShtNm = sFileType & "_Suboxone_Clinic"
'            If sRptNum = 605 Then sS_ShtNm = sFileType & "_Hamdani"
'            If sRptNum = 606 Then sS_ShtNm = sFileType & "_Kasper"
'            If sRptNum = 607 Then sS_ShtNm = sFileType & "_McMillian"
'            If sRptNum = 608 Then sS_ShtNm = sFileType & "_Morrison"
'            If sRptNum = 638 Then sS_ShtNm = sFileType & "_Kalia"
'            If sRptNum = 640 Then sS_ShtNm = sFileType & "_Comey"
'            If sRptNum = 641 Then sS_ShtNm = sFileType & "_McKay"
            
            End Select [/Red]
             
            '"MSP_Assists_Mar2014.xls"
            
            Call xlCopyWorksheets(sFileLoc, sUCI, sS_WrkBk, sT_WrkBk, sS_ShtNm, sT_ShtNm)
        Next R
Public Function xlCopyWorksheets(sFileLoc As String, sUCI As String, sS_WrkBk As String, sT_WrkBk As String, sS_ShtNm As String, sT_ShtNm As String)
    Dim wrkbk As Workbook
    Dim sFileType As String
    'Open destination workbook
    sFileType = "xls"
    Call xlOpen(sFileLoc, sUCI, sT_WrkBk, sT_ShtNm, sFileType)

    
 [Blue]   goXl.Workbooks(sS_WrkBk).Sheets(sS_ShtNm).Copy After:=Workbooks(sT_WrkBk).Sheets(Workbooks(sT_WrkBk).Sheets.Count)  [/Blue]  'orig line works for one worksheet

    
    'Save active workbook
    goXl.ActiveWorkbook.Save
    'Close Active workbook
    goXl.ActiveWorkbook.Close
End Function

 
Upvote 0 Downvote
Check again sheets' names. With sFileType="Assists_", after sS_ShtNm=sFileType&"_NENA" you have two underscores (sS_ShtNm="Assists[!]__[/!]NENA"), does this sheet exist?


combo
 
Upvote 0 Downvote


...AND [highlight #FCE94F]reference[/highlight] ALL your Excel objects correctly
Code: 
    goXl.Workbooks(sS_WrkBk).Sheets(sS_ShtNm).Copy After:=[highlight #FCE94F]goXl.[/highlight]Workbooks(sT_WrkBk).Sheets(Workbooks(sT_WrkBk).Sheets.Count)    'orig line works for one worksheet


Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
goXl.Workbooks(sS_WrkBk).Sheets(sS_ShtNm).Copy After:=[!]goXL.[/!]Workbooks(sT_WrkBk).Sheets([!]goXL.[/!]Workbooks(sT_WrkBk).Sheets.Count)

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Upvote 0 Downvote
Thanks combo,
I fixed the naming issie but I am still getting the same error. When I hover over the code giving me the error the sS_shtNm and sTWrkbk give me the names i would expect. When I hover over Sheets.Count that is where I get (sT_WrkBk).Sheets.Count) subscript out of range.
 
Upvote 0 Downvote


When I hover over Sheets.Count that is where I get (sT_WrkBk).Sheets.Count) subscript out of range.
Click to expand...

Did you fully qualify the Excel reference for the workbook sheet count? You never acknowledged my or PHV's contribution in this matter.

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
I missed one procedure that is setting the goXL.

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


I reviewed the other code and I did add the extra references on the line. I am still getting the run -time error 9 .


Current Code
Code: 
  goXl.Workbooks(sS_WrkBk).Sheets(sS_ShtNm).Copy After:=goXl.Workbooks(sT_WrkBk).Sheets(goXl.Workbooks(sT_WrkBk).Sheets.Count)

When I hover over the code for sS_WrkBk, sS_ShtNm, sT_WrkBk thay are the correct names. When I hover over goXl.Workbooks(sT_WrkBk).Sheets.Count)
I get a message goXl.Workbooks(sT_WrkBk).Sheets.Count) =30 which is the count of all the tabs.
 
Upvote 0 Downvote
In the xlOpen procedure you call xlCreate and thus RESET your goXL object !

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Upvote 0 Downvote
So when I call the open procedure the second time how do I recreate the goXL object?
 
Upvote 0 Downvote
In your xlOpen procedure, replace this:
Call xlCreate
with this:
If goXl Is Nothing Then Call xlCreate

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Upvote 0 Downvote
I added the code to the xlopen procedure and now the code works!! Thanks
 
Upvote 0 Downvote
Sorry to bring this up again but I am getting the same Subscript error 9 again. I created tried to apply the same code as above to a new worksheet but I am getting the run-time error 9 again. I have been working this issue all day trying to resolve it with no luck. I am noticing that both worksheets that are open are read only I don't know if this is the problem or not.
Any help is appreciated.

Tom


Code: 
goXl.Workbooks(sS_WrkBk).Sheets(sS_ShtNm).Copy After:=goXl.Workbooks(sT_WrkBk).Sheets(goXl.Workbooks(sT_WrkBk).Sheets.Count)
 
Upvote 0 Downvote
hi,

Use the Watch Window faq707-4594
to determine if all your objects are valid.

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
Thanks for your advice Skip. I added watches to all the expressions, I brought up the watch window and all the variables that are part of the code above have valid values and all have contexts of the function they are in.
 
Upvote 0 Downvote
A subscript error usually indicates an index or name that does not exist.

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
After fooling around with the code a little I found a solution.

Code: 
goXl.Workbooks(1).Sheets(sS_ShtNm).Copy After:=goXl.Workbooks(sT_WrkBk).Sheets(goXl.Workbooks(sT_WrkBk).Sheets.Count)
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Andrzejek
  • Locked
  • Question
Copy data between SQL and Oracle 1
Replies
8
Views
817
remeng
remeng
K
  • Locked
  • Question
How to resolve define worksheets array
Replies
1
Views
569
combo
combo
remeng
  • Locked
  • Solved
Run-time error '429': ActiveX component can't create object From Excel to Word
Replies
9
Views
1K
remeng
remeng
remeng
  • Locked
  • Solved
Combine two working macros into one for MS Word 1
Replies
7
Views
850
strongm
strongm
feipezi
  • Locked
  • Question
How to make a recorded Excel macro (convert a text file to a Workbook) more efficient?
Replies
11
Views
504
SkipVought
S

Part and Inventory Search

Sponsor

Back
Top