Putting data in to a set excel file (1 Viewer)

[dmorgan20]

I am trying to open a pre-saved excel file then put data in to it from an SQL query.

what's actually happening with the code below is that it opens the pre-saved excel as intended, but the it opens a new workbook and pastes the data in to it.

How can I paste the data only in to the pre-saved excel?

Public Sub ExportQuery(ByVal Query As String, ByVal ShowToUser As Boolean, ByVal TabName As String, ByVal TabCount As Integer, ByRef xlApp As Excel.Application, ByRef xlWB As Object)
'This will export a query to Excel and display it, or save it to a path if requested.
Dim rst As DAO.Recordset
Dim rstA As DAO.Recordset
Dim xlSh As Excel.Worksheet
Dim i As Long
Dim ID As String
Dim sql As String: sql = ""
    
    Set rst = CurrentDb.OpenRecordset(Query, dbOpenDynaset, dbSeeChanges)
    Set rstA = CurrentDb.OpenRecordset("SELECT DISTINCT [Extension Reference] FROM CFR")
    xlApp.Workbooks.Open "FILE PATH HERE", True, False
    With xlApp
          
   .Visible = ShowToUser
    
    If TabCount < 1 Then
            Set xlWB = .Workbooks.Add
            Set xlSh = xlWB.Worksheets(xlWB.Worksheets.Count)
        
        With xlSh
            .Name = "ID"
            .Select
            .Range("A2") = "FullFITID"
            .Range("A3").CopyFromRecordset rstA
       Set xlSh = xlWB.Worksheets(xlWB.Worksheets.Count)
            xlWB.Worksheets.Add After:=xlSh
            .Select
        End With
    Else
        Set xlSh = xlWB.Worksheets(xlWB.Worksheets.Count)
        xlWB.Worksheets.Add After:=xlSh
    End If
    
    End With
    
    Set xlSh = xlWB.Worksheets(xlWB.Worksheets.Count)
    With xlSh
        .Name = TabName
        .Select
        .Range("A2").CopyFromRecordset rst
    
         For i = 1 To rst.Fields.Count
             .Cells(1, i).Value = rst.Fields(i - 1).Name
         Next i
             
        xlApp.Cells.EntireColumn.AutoFit
    End With
    
'Set xlSh = xlWB.Worksheets(xlWB.Worksheets("ID").Select)
'With xlSh
      ' Add formula to excel
      '      .Range("B2").Select
      '      ActiveCell.FormulaR1C1 = "='Tariff code'!R[-1]C"
      '      Range("B2").Select
      '      Selection.AutoFill Destination:=Range("B2:D2"), Type:=xlFillDefault
      '      Range("B2:D2").Select
      '      Range("B3").Select
      '      ActiveCell.FormulaR1C1 = _
      '         "=INDEX('Tariff code'!C,MATCH(ID!RC1,'Tariff code'!C1,0))"
      '      Range("B3").Select
      '      Selection.AutoFill Destination:=Range("B3:D3"), Type:=xlFillDefault
      '      Range("B3:D3").Select
      '      Selection.AutoFill Destination:=Range("B3:D89395")
      '      Range("B3:D150000").Select
      '      Cells.Select
      '      Cells.EntireColumn.AutoFit
'End With
    
End Sub

 

[Ranman256]

remove the IF TABCOUNT < 1 code.
your wb will always have sheets.

select the tab where you want to paste:
sheets("mysheet").activate

 

[dmorgan20]

Thanks

I get the following error: Subscript out of range

Code added: Sheets("Sheet1").Activate

 

[Ranman256]

XLapp.sheets("sheet1")

Also remove
worksheets.add

 

[dmorgan20]

Method or data member not found - Doh!

 

[arnelgp]

you will have to modify that sub and add another optional parameter for the name of existing wb. optional if blank means create new wb, if not then use that wb. if you are going to use the existing one, you need an overhaul for the code since the current code overwrites the existing data.

 

[arnelgp]

i suggest you create a new subeoutine fir existing wb to handle and leave the old sub for new wb.

 

[arnelgp]

also what do you like, erase the existing data or delete and replace with new data?

 

[dmorgan20]

Thank you, wouldn't be to sure how to do an overhaul unfortunately

 

[dmorgan20]

also what do you like, erase the existing data or delete and replace with new data?

Ideally delete every tab apart from one called 'ID'

 

[GinaWhipp]

I would do this in two parts. Part 1 would be (UNTESTED)...

Public Sub ExportQuery()
'This will export a query to Excel and display it, or save it to a path if requested.
   
        Dim ApXL As Object
        Dim xlWBk As Object
        Dim strPath As String
        Dim rs As DAO.Recordset
        Dim xlWSh As Object
    
            strPath = "FULL PATH TO OLD WORKBOOK TEMPLATE HERE"
        
            Set rs = CurrentDb.OpenRecordset("SELECT DISTINCT [Extension Reference] FROM CFR", dbOpenDynaset)
            Set ApXL = CreateObject("Excel.Application")
        
            Set xlWBk = ApXL.Workbooks.Open(strPath)
            ApXL.Visible = True
                
            Set xlWSh = xlWBk.Worksheets("ID")
            xlWSh.Range("A2").Value = "FullFITID"
        
            rs.MoveFirst
            xlWSh.Range("A3").CopyFromRecordset rs
            ' selects the first cell to unselect all cells
            xlWSh.Range("A3").Select
            
        xlWSh.Activate
        xlWSh.Cells.Rows(3).EntireColumn.AutoFit
    
        rs.Close
        Set rs = Nothing
        'Remove prompts to save the report
        ApXL.DisplayAlerts = False
        xlWBk.SaveAs "FULL PATH NEW WORKBOOK NAME HERE", 51
        ApXL.DisplayAlerts = True
        'Open after report is completes
        ApXL.Visible = True
    
End Sub

Then Part 2 be the above but putting the new workbook name at the top, copy\paste your data and then close and save.