Export table access>65536 lignes vers Excel

Voilà...
https://support.microsoft.com/en-us/help/120596

Donc : Office 2007 ou

Le code de la macro :

Sub LargeFileImport()

'Dimension Variables
Dim ResultStr As String
Dim FileName As String
Dim FileNum As Integer
Dim Counter As Double
'Ask User for File's Name
FileName = InputBox("Please enter the Text File's name, e.g. test.txt")
'Check for no entry
If FileName = "" Then End
'Get Next Available File Handle Number
FileNum = FreeFile()
'Open Text File For Input
Open FileName For Input As #FileNum
'Turn Screen Updating Off
Application.ScreenUpdating = False
'Create A New WorkBook With One Worksheet In It
Workbooks.Add template:=xlWorksheet
'Set The Counter to 1
Counter = 1
'Loop Until the End Of File Is Reached
Do While Seek(FileNum) <= LOF(FileNum)
'Display Importing Row Number On Status Bar
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & FileName
'Store One Line Of Text From File To Variable
Line Input #FileNum, ResultStr
'Store Variable Data Into Active Cell
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If

'For Excel versions before Excel 97, change 65536 to 16384
If ActiveCell.Row = 65536 Then
'If On The Last Row Then Add A New Sheet
ActiveWorkbook.Sheets.Add
Else
'If Not The Last Row Then Go One Cell Down
ActiveCell.Offset(1, 0).Select
End If
'Increment the Counter By 1
Counter = Counter + 1
'Start Again At Top Of 'Do While' Statement
Loop
'Close The Open Text File
Close
'Remove Message From Status Bar
Application.StatusBar = False

End Sub

Mec..... pourquoi t'irais pas t'allonger un peu et prendre le soleil plutot? C'est quoi ces histoires serieux? peace..... repose toi.

Merci Groggy. En fait j'avais essayé ce code mais une erreur se produit à la ligne
If Left( ResultStr, 1) = "=" Then
Et je ne sais pas ce que signifie cette ligne.
Merci encore.

Bonjour,

peut-être as-tu des lignes vides...
Essaie en remplaçant par :
if len(ResultStr)=0 then</gras>
elseIf Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If

eric

If Left(ResultStr, 1) = "="
regarde si la ligne commence par le caractère =, si oui ajoute le caractère ' devant pour qu'excel ne l'interprete pas comme une formule.
Il faudrait déposer un extrait de ton fichier (avec la ligne de données ou l'erreur se produit) sur cijoint.fr et coller le lien ici

J'ai déposé mon fichier entier à l'adresse: http://dl.free.fr/getfile.pl?file=/Ngx9RJTO

Tu écris: "avec la ligne de données ou l'erreur se produit". En fait, lorsque je lance l'exécution, j'ai le message "Erreur de compilation. Projet ou bibliothèque introuvable." Le curseur s'arrête sur la fonction "Left".

Merci.

Impossible à telecharger.
Allege ton fichier et utilise cijoint.fr

J'ai pu résoudre le problème de "Erreur de compilation. Projet ou bibliothèque introuvable." grâce à l'aide en ligne de microsoft. Maintenant, le code me donne un fichier Excel dans lequel se trouve toutes les données. Seulement, les données de chaque ligne sont toutes dans une colonne.
Je joins le fichier xls (réduit, mais tu pourras voir ce que ça donne) et le fichier texte (réduit aussi).

Le fichier http://www.cijoint.fr/cjlink.php?file=cj200912/cijgOxsJRA.xls
Le fichier texte (allégé) est à l'adresse: http://www.cijoint.fr/cjlink.php?file=cj200912/cijYGBweQf.txt

Merci.

Salut,

Seulement, les données de chaque ligne sont toutes dans une colonne.

C'est normal. La solution proposé sur le site de microsoft ne traite pas le séparateur.
La variable ResultStr contiendra la ligne entière.
Il faudra utiliser par exemple la fonction split en fonction de séparateur.

Re,

Essaie avec ça.
Donc tu ouvres un classeur vide et tu lances la macro.
J'ai fait sur 65000 lignes au lieu de 2^16 lignes

Option Explicit
Sub insertion()
    Dim i As Long, j As Long, r As Long
    Dim idxT As Integer
    Dim ligne As String
    Dim t
    i = 0
    j = 1
    r = 1
    
    Open "D:\fic.txt" For Input As #1
    Application.ScreenUpdating = False
    ActiveWorkbook.Sheets.Add.Move after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "feuille" & j
    Do While Not EOF(1)
        i = i + 1
        Line Input #1, ligne
        If i Mod 65000 = 0 Then
            ActiveWorkbook.Save
            r = 1
            j = j + 1
            ActiveWorkbook.Sheets.Add.Move after:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = "feuille" & j
        End If
        t = Split(ligne, " ")
        Debug.Print j
        For idxT = 0 To UBound(t)
            Sheets("feuille" & j).Cells(r, idxT + 1) = t(idxT)
        Next idxT
        r = r + 1
        
    Loop
    Application.ScreenUpdating = True
    Close #1
    MsgBox "Traitement terminé", vbInformation
        
End Sub

J'ai fini par comprendre le code de microsoft!
Merci beaucoup pour ton code: c'est du tonnerre et c'est propre. Je suis plus que satisfait car ça marche à merveille. Merci encore et merci aussi à eriiic.