I am trying to export an query into excel and then transpose the data so it is vertical instead of horizontal I have it mostly working except when try to do the transpose it give me an Rune Time error 1004, PasteSpecial method of Range Class failed. If anyone has any idea where I am going wrong, any suggestion would be helpful. Originally tried with TransferSpreadsheet method and then open it up to transpose and that didn't work any better.
The error appears to be on this line. Have tried a few variations and either get that error or syntax error.
xlSheet.Cells(1, rs.Fields.Count + 2).PasteSpecial xlPasteAll, xlPasteSpecialOperationNone, False, True
The full code is here for the export and transpose
' Initialize database and recordset
Set db = CurrentDb
Set rs = db.OpenRecordset(queryName, dbOpenSnapshot)
' Initialize Excel application
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Sheets(1)
' Export field names to Excel
For i = 0 To rs.Fields.Count - 1
xlSheet.Cells(1, i + 1).Value = rs.Fields(i).Name
Next i
' Export data to Excel
i = 2 ' Start from the second row to leave space for field names
Do While Not rs.EOF
For j = 0 To rs.Fields.Count - 1
xlSheet.Cells(i, j + 1).Value = rs.Fields(j).Value
Next j
rs.MoveNext
i = i + 1
Loop
' Transpose data
xlSheet.Range("A1").CurrentRegion.Copy
xlSheet.Cells(1, rs.Fields.Count + 2).PasteSpecial xlPasteAll, xlPasteSpecialOperationNone, False, True
' Clean up
rs.Close
Set rs = Nothing
Set db = Nothing
' Save and close Excel workbook
xlBook.SaveAs filePath
xlBook.Close False
xlApp.Quit
' Release Excel objects
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
MsgBox "Query exported and transposed successfully!", vbInformation
The error appears to be on this line. Have tried a few variations and either get that error or syntax error.
xlSheet.Cells(1, rs.Fields.Count + 2).PasteSpecial xlPasteAll, xlPasteSpecialOperationNone, False, True
The full code is here for the export and transpose
' Initialize database and recordset
Set db = CurrentDb
Set rs = db.OpenRecordset(queryName, dbOpenSnapshot)
' Initialize Excel application
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Sheets(1)
' Export field names to Excel
For i = 0 To rs.Fields.Count - 1
xlSheet.Cells(1, i + 1).Value = rs.Fields(i).Name
Next i
' Export data to Excel
i = 2 ' Start from the second row to leave space for field names
Do While Not rs.EOF
For j = 0 To rs.Fields.Count - 1
xlSheet.Cells(i, j + 1).Value = rs.Fields(j).Value
Next j
rs.MoveNext
i = i + 1
Loop
' Transpose data
xlSheet.Range("A1").CurrentRegion.Copy
xlSheet.Cells(1, rs.Fields.Count + 2).PasteSpecial xlPasteAll, xlPasteSpecialOperationNone, False, True
' Clean up
rs.Close
Set rs = Nothing
Set db = Nothing
' Save and close Excel workbook
xlBook.SaveAs filePath
xlBook.Close False
xlApp.Quit
' Release Excel objects
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
MsgBox "Query exported and transposed successfully!", vbInformation