Using Excel VBA to Copy an ADODB Recordset to Multiple Worksheets

In adding functionality to an ancient Excel VBA reporting app for an Oracle database, I decided to set up a temporary worksheet to use as a place to store data before copying it to multiple other worksheets rather than copying directly from the recordset multiple times.

Basically, this VBA procedure takes an ADODB recordset and a Boolean value as parameters. The recordset is the data source, and the Boolean indicates whether or not the data will be copied to a particular worksheet. The temporary worksheet is cleared before the recordset is copied into it, and is cleared again after the data is copied to the other worksheet(s).

Public Sub CopyToSheets(ByRef rs As ADODB.Recordset, ByVal bCopyToSecondSht As Boolean)
    Dim MainSht As Worksheet, TempSht As Worksheet, Rng As Range, c As Range, lastRow As Long, intNextRow As Integer

    Set MainSht = ActiveWorkbook.Worksheets(cMainSht)
    Set TempSht = ActiveWorkbook.Worksheets(cTempData)


    TempSht.Cells(1, 1).CopyFromRecordset rs

    lastRow = TempSht.Range("A" & Rows.count).End(xlUp).Row
    Set Rng = TempSht.Range("A1:A" & lastRow)
    For Each c In Rng
        intNextRow = NextRowNumber(MainSht)
        c.EntireRow.Copy MainSht.Cells(intNextRow, 1)
        If bCopyToSecondSht Then
            Dim SecondSht As Worksheet
            Set SecondSht = ActiveWorkbook.Worksheets(cSecondSht)
            intNextRow = NextRowNumber(SecondSht)
            c.EntireRow.Copy SecondSht.Cells(intNextRow, 1)
        End If
    Next c
End Sub
Houston, TX 77002

Leave a Reply