aide sous excel

[megusta]

Bonjour a tous
je voudrai utiliser un macro automatique pour que j'importe dans chaque colonne A B C D E etc..192 lignes j'ai mis ça :

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 192
If ActiveCell.Row = 65536 Then
'If On The Last Row Then Add A New Row
ActiveWorkbook.Row.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

aider moi SVP Merci

 

[MichelXld]

Re : aide sous excel

bonjour


La procédure ci-dessous importe les données d'un fichier txt et insère une nouvelle feuille toutes les 192 lignes.
La première ligne (supposée être un entête) n'est pas récupérée dans cet exemple mais je complèterai la macro si le principe de base te convient:

Sub Extraction_V2()
 
Dim Repertoire As String, Fichier As String
Dim strFullName As Variant
Dim Cn As Object, Rs As Object
 
'Sélection du ficher
strFullName = Application.GetOpenFilename _
    ("Fichiers textes (*.txt),*.txt", , _
    "Sélectionnez un fichier :")
 
'On sort si aucun fichier n'est sélectionné
If strFullName = False Then Exit Sub
 
Application.ScreenUpdating = False
Fichier = Dir(strFullName)
Repertoire = Left(strFullName, Len(strFullName) _
    - (Len(Fichier) + 1))
 
'Connection
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Repertoire & ";" & _
    "Extended Properties=""text;HDR=Yes;FMT=Delimited"""
 
'Requete
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open "SELECT * FROM [" & Fichier & "]", Cn, 3, 1, 1
 
'boucle sur le résultat de la requete
While Not Rs.EOF
    'Ajout Feuille
    Worksheets.Add
    'Ecriture des données dans la feuille
    '192 spécifie le nombre de lignes par feuille
    ActiveSheet.Range("A1").CopyFromRecordset Rs, 192
Wend
 
Rs.Close
Set Rs = Nothing
Cn.Close
Set Cn = Nothing
Application.ScreenUpdating = True
End Sub

bon week end
michel
Microsoft Excel MVP

 

[megusta]

Re : aide sous excel

merci
pour votre aide
mais il me faut une solution pour importer 192 champs a chaque feuille word
(fusion)

 

[MichelXld]

Re : aide sous excel

bonjour

mais il me faut une solution pour importer 192 champs a chaque feuille word
(fusion)

1. Je ne comprend pas le sens de ton dernier message.

2. Quel rapport avec ta question et ta macro initiale ?


bon week end
michel
Microsoft Excel MVP

 

[megusta]

Re : aide sous excel

Bonjour
j'ai un fichier excel (50 000) enregistrement je doit imprimer chaque 192 ensemble en ordre
j'ai essayer de fusionner en word (recréation de table)il ne permet que en vertical
ya t'il un moyen SVP peut être mettre les donnée en horizontal
ou en excel importer dans chaque ligne 192 enregistrement
merci