ADODB CopyFromRecordset problem

[siocnarf]

Hi,

I have 2 Excel 2007 files and wish to merge them in a 3rd one. So I choosed using ADODB Recordset.

Each files are extraction from Windows Event viewer and the message might be quiet large.

When I reached CopyFromRecordset rsData the informations is appearing in the 3rd excel file. The file should get the 4000th rows but when it is reaching row 30 column L then I get:
Erreurs d'exécution -2147467259(80004005)
La méthode 'CopyFromRecordset' de l'objet 'Range' a échoué

The cell should have 125 line of text. So I am thinking the data is too large... Am I right?

What may I do to bypass that problem?

Sub TestConso()
Dim Fich1$, Fich2$, Source1$, Source2$, Cible$
  Fich1 = "c:\temp\a.xlsx"
  Fich2 = "c:\temp\b.xlsx"
  Source1 = "Feuil2"
  Source2 = "Feuil2"
  Cible = "Feuil2"
  ConsoDatas Fich1, Source1, Cible
  ConsoDatas Fich2, Source1, Cible
End Sub
Public Sub ConsoDatas(NomFichier$, FeuilleSource$, FeuilleCible$)
'Va chercher dans le classeur NomFichier (sans l'ouvrir) les données
'de la feuille FeuilleSource et les copie dans la feuille FeuilleCible
'du classeur actif, à la suite des données (éventuellement) déjà présentes.
'(La ligne d'entêtes de FeuilleSource n'est pas importée)
'inspiré de Rob Bovey, mpep
'nécessite une référence à la librairie
'Microsoft ActiveX Data Object 2.x Library
'http://www.excel-downloads.com/forum/35896-activer-la-reference-microsoft-activex-data-object.html
'ThisWorkbook.VBProject.References.AddFromFile ("C:\Program Files\Common Files\System\ado\msado20.tlb ")
'http://blogs.codes-sources.com/coq/archive/2007/09/21/classeurs-excel-via-oledb-et-pour-les-versions-2007-xlsb-xlsm-xlsx.aspx
'http://frederic.sigonneau.free.fr/code/Ado/ADOConsolidation.txt
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim Li&, FeuilleDest
'Version de Excel
'"12"= Excel 2007
'"11"= Excel 2003
StrVersion = Application.Version
    If StrVersion < 12 Then
        'Pre-2007
        ''' Crée la chaîne de connexion
        'Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Extended Properties="Excel 8.0;HDR=YES;IMEX=1";
        szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & NomFichier & ";" & _
            "Extended Properties=Excel 8.0;"
    Else
        ' À partir de 2007
        'Provider=Microsoft.ACE.OLEDB.12.0;Data Source={0};Extended Properties="Excel 12.0;HDR=YES;IMEX=1";
        szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & NomFichier & ";" & _
            "Extended Properties=Excel 12.0;"
    End If
    ' La requête est basée sur le nom de la feuille. Ce nom
    ' doit se terminer par un $ et doit être entouré de crochets droits.
    szSQL = "SELECT * FROM [" & FeuilleSource & "$];"
    Set rsData = New ADODB.Recordset
    rsData.Open szSQL, szConnect, adOpenForwardOnly, _
        adLockReadOnly, adCmdText
    
    
    'où envoyer les données :
    Workbooks("consol.xlsx").Activate
    Set FeuilleDest = ActiveWorkbook.Sheets(FeuilleCible)
    'Quelle est la dernière ligne de la feuille?
    Derniereligne = Rows.Count
    Li = FeuilleDest.Range("A" & Derniereligne).End(xlUp).Row + 1
    If Li = 2 Then Li = 1 'Je souhaite que la copie se fasse à partir de la première ligne.
    'envoi sur la première ligne vide
    If Not rsData.EOF Then
      FeuilleDest.Range("A" & Li).CopyFromRecordset rsData
    Else
      'si la source était vide...
      MsgBox "Aucun enregistrement renvoyé.", vbCritical
    End If
    ''' On nettoie pour finir...
    rsData.Close
    Set rsData = Nothing
End Sub

Thanks,

Francois