Export multiple queries with results to Excel into one worksheet

Question

I want to export all queries in my database with the beginning "WWEI", which have records, into one Excel worksheet and list them under each other.

strFullPath = "C:\Users\test.xlsx"
Set wb = xl.Workbooks.Add
Set wb = xl.Workbooks.Open(strFullPath)   
Set ws = wb.Worksheets(1)      
Set r = ws.Range("a1")         
r = "Possible Mistakes"

Set r = r.Offset(2, 1)

For Each qdf In CurrentDb.QueryDefs
    If Mid(qdf.Name, 1, 4) = "WWEI" Then
        querybezeichnung = qdf.Name
        If DCount("*", querybezeichnung) > 0 Then

            Set rs = CurrentDb.OpenRecordset(querybezeichnung)
            With rs
                For i = 1 To .Fields.Count
                    r.Cells(1, i) = .Fields(i - 1).Name
                    r.Cells(1, i).Font.Bold = True
                    'r.Cells(1, i).AutoFilter
                Next i
            End With
            Set r = r.Offset(1, 0)

            r.CopyFromRecordset rs
            rs.Close
            Set r = r.End(xlDown).Offset(2, 0)

        End If
    End If
Next qdf

I have a runtime error "1004" on line:

Set r = r.End(xlDown).Offset(2, 0)

`Set r = r.End(xlDown).Offset(2, 0)` And hence you should avoid using `xlDown`. Let's say, `r` is `[a1]` and then there is nothing after cell `A1`. When you say `r.End(xlDown)`. You are referring to the last cell *(A1048576 in case of Excel 2007+ or A65536 in case Excel 2003)* and then on top of that you are telling Excel to go beyond 2 rows... Obviously excel will give you the error. Use `xlUp` to find the last row and then do what you want. See [This](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba/11169920#11169920) on how to find the last row. — Siddharth Rout, Apr 04 '19 at 13:41
Thank you for your tip, i solved this like: Dim lngLastRow As Long With r.Worksheet lngLastRow = .Cells(.Rows.Count, r.Column).End(xlUp).Row .Range(.Cells(lngLastRow + 1, 1), .Cells(.Rows.Count, 1)).EntireRow.Delete End With Set r = r.Offset(lngLastRow, 0) — jimmyluder123, Apr 04 '19 at 14:08

score 0 · Answer 1 · edited May 19 '19 at 02:04

Set r = r.End(xlDown).Offset(2, 0)
 instead of dis can't you use
Set r = r.Offset( recordcountofrs + 2, 0)
'________________________________________________________
strFullPath = "C:\Users\test.xlsx"
Set wb = xl.Workbooks.Add
Set wb = xl.Workbooks.Open(strFullPath)   
Set ws = wb.Worksheets(1)      
Set r = ws.Range("a1")         
r = "Possible Mistakes"

Set r = r.Offset(2, 1)

For Each qdf In CurrentDb.QueryDefs
    If Mid(qdf.Name, 1, 4) = "WWEI" Then
        querybezeichnung = qdf.Name
        If DCount("*", querybezeichnung) > 0 Then

            Set rs = CurrentDb.OpenRecordset(querybezeichnung)
            With rs
                For i = 1 To .Fields.Count
                    r.Cells(1, i) = .Fields(i - 1).Name
                    r.Cells(1, i).Font.Bold = True
                    'r.Cells(1, i).AutoFilter
                Next i
            End With
            Set r = r.Offset(1, 0)

            r.CopyFromRecordset rs
        LstRow = rs.RecordCount '<== this line added 
            rs.Close
            Set r = r.Offset(LstRow+2, 0) '<== this line changed 

        End If
    End If
Next qdf

Export multiple queries with results to Excel into one worksheet

1 Answers1