Option Explicit
 
Public Sub AdoAusgabeVariationen()
 ' Peter Haserodt 2007
 Dim oAdoConnection As Object, oAdoRecordset As Object
 Dim sAdoConnectString As String, sPfad As String
 Dim sQuery As String
 Dim oZielStartRange As Range
 On Error GoTo Fehler
 sPfad = ThisWorkbook.FullName
 Set oZielStartRange = ThisWorkbook.Worksheets("Ziel").Range("b2")
 Set oAdoConnection = CreateObject("ADODB.CONNECTION")
 sAdoConnectString = _
 "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & sPfad
 oAdoConnection.Open sAdoConnectString
 Set oAdoRecordset = CreateObject("ADODB.RECORDSET")
 sQuery = "Select [Monat],[Wert] from [Quelle$] where Monat='März'"
 With oAdoRecordset
  .Source = sQuery
  .ActiveConnection = oAdoConnection
  .Open
  ''' #################################################################
  ''' #########  Verschiedene Optionen, immer nur eine auskommentieren
  'Call AusgabePerCopyFromRecordset(oAdoRecordset, oZielStartRange)
  'MsgBox AusgabePerGetRows(oAdoRecordset, oZielStartRange)
  'Call AusgabePerLoop(oAdoRecordset, oZielStartRange)
  ''' #################################################################
 End With
 Aufraeumen:
 On Error Resume Next ' Sehr Faul
 oAdoRecordset.Close
 oAdoConnection.Close
 Set oAdoRecordset = Nothing
 Set oAdoConnection = Nothing
 Exit Sub
 Fehler:
 MsgBox "Fehler: " & Err.Description
 Resume Aufraeumen
End Sub
 
Private Sub AusgabePerCopyFromRecordset(DasRecordSet As Object, _
 StartAusgabe As Range)
 ' Peter Haserodt 2007
 StartAusgabe.CurrentRegion.Clear
 StartAusgabe.CopyFromRecordset DasRecordSet
End Sub
 
Private Function AusgabePerGetRows(DasRecordSet As Object, _
 StartAusgabe As Range) As Long
 ' Peter Haserodt 2007
 Dim vX As Variant, iRowCount As Long, iColCount As Long
 On Error GoTo Fehler
 StartAusgabe.CurrentRegion.Clear
 vX = WorksheetFunction.Transpose(DasRecordSet.getrows)
 iRowCount = UBound(vX, 1)
 On Error Resume Next
 iColCount = UBound(vX, 2)
 On Error GoTo Fehler
 If iColCount = 0 Then
  With StartAusgabe.Parent
   .Range(.Cells(StartAusgabe.Row, StartAusgabe.Column), _
   .Cells(StartAusgabe.Row, _
   StartAusgabe.Column + iRowCount - 1)).Value = vX
  End With
  AusgabePerGetRows = 1
 Else
  With StartAusgabe.Parent
   .Range(.Cells(StartAusgabe.Row, StartAusgabe.Column), _
   .Cells(StartAusgabe.Row + iRowCount - 1, _
   StartAusgabe.Column + iColCount - 1)).Value = vX
  End With
  AusgabePerGetRows = iRowCount + 1
 End If
 Exit Function
 Fehler:
 AusgabePerGetRows = 0
End Function
 
Private Sub AusgabePerLoop(DasRecordSet As Object, _
 StartAusgabe As Range)
 Dim k As Long, z As Long
 'Eine schnarchlangsame Ausgabemethode
 'für Sie zum rumspielen
 StartAusgabe.CurrentRegion.Clear
 z = -1
 With DasRecordSet
  Do While Not .EOF
   z = z + 1
   For k = 0 To .fields.Count - 1
    StartAusgabe.Offset(z, k) = .fields(k)
   Next k
   .movenext
  Loop
 End With
End Sub