copier un fichier texte dans la fenêtre active

Bonsoir.
Essaie :

Sub multiselection()
' Affichage de la boîte de dialogue standard "Ouvrir" pour sélection de(s)
fichier (s)
nomfich = Application.GetOpenFilename(Title:="Ouverture des fichiers CEXP",
MultiSelect:=True)

' si aucun choix effectué, sortie du programme
If TypeName(nomfich) = "Boolean" Then
'MsgBox("Aucun fichier n'a été sélectionné. Fin de la procédure", vbCritical
+ vbOKOnly,"Sortie")
Exit Sub
End If

' si choix
Dim rep As Long
Dim Liste As String
Dim compteur As Byte
Dim Sh As Worksheet
Dim Ligne1 As Long
Dim Ligne2 As Long
Set Sh = ActiveSheet
For compteur = 1 To UBound(nomfich)
Liste = Liste & vbCr & nomfich(compteur)
Next compteur
'affichage de l'ensemble de la liste des fichiers et proposition d
'ouverture
rep = MsgBox("Voici la liste des fichiers CEXP sélectionnés." _
& Liste & vbCr & "Voulez-vous les ouvrir ?", vbYesNo + vbQuestion, "Ouvrir
les fichiers CEXP ?")
'ouverture des fichiers en cas de réponse positive
If rep = vbYes Then
For compteur = 1 To UBound(nomfich)
Workbooks.Open Filename:=nomfich(compteur)
Ligne = Sh.Cells.Find("*", [A1], , , , xlPrevious).Row + 1
ActiveSheet.UsedRange.Copy Sh.Cells(Ligne, 1)
Next compteur
ActiveWorkbook.Close False
End If
End Sub

--
Cordialement.
Daniel
"fetnat" <fetnat@caramail.com> a écrit dans le message de news:
%23xAFq29KJHA.4708@TK2MSFTNGP02.phx.gbl...

Bonsoir,

Je souhaite utiliser la macro multiselection qui se trouve dans Excelabo
http://www.excelabo.net/excel/repertoiresarborescence.php#multiselection
pour copier un fichier texte dans la fenêtre active.



La ligne suivante ouvre un nouveau classeur et copie le fichier texte
selectionné d'un seul coup. Je ne veux pas ouvrir un nouveau classeur à
chaque nouveau fichier texte mais faire la copie dans la feuille active.

Workbooks.Open FileName:=nomfich(1)
'si un seul fichier a été sélectionné, il est ouvert




Comment écrire le fichier texte sélectionné dans la feuille active ?
Je n'arrive pas à remplacer Workbooks.Open

J'ai bien une autre macro qui copie le fic txt ligne par ligne dans la
feuille active avec Open file_name For Binary As #fnum.
J'ai parfois plus de 1500 lignes par fic.txt. A terme je veux traiter un
répertoire de 250 fic.txt. Cela risque d'être longuet.

Merci pour votre aide

Cordialement

Fetnat

Bonjour Daniel.C

Merci pour l'aide

Je me débat depuis ce matin, mais je bloque avec une erreur sur
Ligne = Sh.Cells.Find("*", [A1], , , , xlPrevious).Row + 1

"Var objet ou var de bloc With non definie"

A ce moment c'est le nouveau classeur qui a pour nom monfic.txt (avec
une seule page contenant mes données texte) qui est actif.
Sh.Cells.Find ne s'applique pas. J'ai essayé des variantes qui ne
passent pas, et de toutes façons une fois que j'aurais la var Ligne, il
faudra que je revienne sur mon classeur original pour faire le paste,
puis je dois fermer le classeur relais avec le texte.

Le but c'est de récupérer plusieurs fichiers textes, chacun dans une
page d'un seul classeur maître.

Je rame en toute cordialité...

Fetnat


Daniel.C a écrit :

Bonsoir.
Essaie :

Sub multiselection()
' Affichage de la boîte de dialogue standard "Ouvrir" pour sélection de(s)
fichier (s)
nomfich = Application.GetOpenFilename(Title:="Ouverture des fichiers CEXP",
MultiSelect:=True)

' si aucun choix effectué, sortie du programme
If TypeName(nomfich) = "Boolean" Then
'MsgBox("Aucun fichier n'a été sélectionné. Fin de la procédure", vbCritical
+ vbOKOnly,"Sortie")
Exit Sub
End If

' si choix
Dim rep As Long
Dim Liste As String
Dim compteur As Byte
Dim Sh As Worksheet
Dim Ligne1 As Long
Dim Ligne2 As Long
Set Sh = ActiveSheet
For compteur = 1 To UBound(nomfich)
Liste = Liste & vbCr & nomfich(compteur)
Next compteur
'affichage de l'ensemble de la liste des fichiers et proposition d
'ouverture
rep = MsgBox("Voici la liste des fichiers CEXP sélectionnés." _
& Liste & vbCr & "Voulez-vous les ouvrir ?", vbYesNo + vbQuestion, "Ouvrir
les fichiers CEXP ?")
'ouverture des fichiers en cas de réponse positive
If rep = vbYes Then
For compteur = 1 To UBound(nomfich)
Workbooks.Open Filename:=nomfich(compteur)
Ligne = Sh.Cells.Find("*", [A1], , , , xlPrevious).Row + 1
ActiveSheet.UsedRange.Copy Sh.Cells(Ligne, 1)
Next compteur
ActiveWorkbook.Close False
End If
End Sub

J'ai la boucle finale qui ajoute une feuille et qui copie le fichier
texte sans ouvrir un classeur intermediaire.
J'ai les grandes lignes, encore quelques détails à revoir.


If rep = vbYes Then
For compteur = 1 To UBound(nomfich)
fich = nomfich(compteur)
'fich = Application.GetOpenFilename("Fichiers
txt(*.txt),*.txt") ' sans selection manuelle
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" &
fich, Destination:=Range("A1"))
.Name = fich '"MesDonnées"
.TextFileSpaceDelimiter = False
.Refresh BackgroundQuery:úlse
End With
ActiveWorkbook.Sheets.Add
Next compteur
ActiveWorkbook.Close True
End If

Encore merci pour m'avoir montré la voie.

Cordialement

Fetnat


fetnat a écrit :

Bonjour Daniel.C

Merci pour l'aide

Je me débat depuis ce matin, mais je bloque avec une erreur sur
Ligne = Sh.Cells.Find("*", [A1], , , , xlPrevious).Row + 1

"Var objet ou var de bloc With non definie"

A ce moment c'est le nouveau classeur qui a pour nom monfic.txt (avec
une seule page contenant mes données texte) qui est actif.
Sh.Cells.Find ne s'applique pas. J'ai essayé des variantes qui ne
passent pas, et de toutes façons une fois que j'aurais la var Ligne, il
faudra que je revienne sur mon classeur original pour faire le paste,
puis je dois fermer le classeur relais avec le texte.

Le but c'est de récupérer plusieurs fichiers textes, chacun dans une
page d'un seul classeur maître.

Je rame en toute cordialité...

Fetnat


Daniel.C a écrit :

Bonsoir.
Essaie :

Sub multiselection()
' Affichage de la boîte de dialogue standard "Ouvrir" pour sélection
de(s) fichier (s)
nomfich = Application.GetOpenFilename(Title:="Ouverture des fichiers
CEXP", MultiSelect:=True)

' si aucun choix effectué, sortie du programme
If TypeName(nomfich) = "Boolean" Then
'MsgBox("Aucun fichier n'a été sélectionné. Fin de la procédure",
vbCritical + vbOKOnly,"Sortie")
Exit Sub
End If

' si choix
Dim rep As Long
Dim Liste As String
Dim compteur As Byte
Dim Sh As Worksheet
Dim Ligne1 As Long
Dim Ligne2 As Long
Set Sh = ActiveSheet
For compteur = 1 To UBound(nomfich)
Liste = Liste & vbCr & nomfich(compteur)
Next compteur
'affichage de l'ensemble de la liste des fichiers et proposition d
'ouverture
rep = MsgBox("Voici la liste des fichiers CEXP sélectionnés." _
& Liste & vbCr & "Voulez-vous les ouvrir ?", vbYesNo + vbQuestion,
"Ouvrir les fichiers CEXP ?")
'ouverture des fichiers en cas de réponse positive
If rep = vbYes Then
For compteur = 1 To UBound(nomfich)
Workbooks.Open Filename:=nomfich(compteur)
Ligne = Sh.Cells.Find("*", [A1], , , , xlPrevious).Row + 1
ActiveSheet.UsedRange.Copy Sh.Cells(Ligne, 1)
Next compteur
ActiveWorkbook.Close False
End If
End Sub

Au temps pour moi. Ca plante quand la feuille réceptrice est vierge; voici
la macro corrigée :

Sub multiselection()
' Affichage de la boîte de dialogue standard "Ouvrir" pour sélection de(s)
fichier (s)
nomfich = Application.GetOpenFilename(Title:="Ouverture des fichiers CEXP",
MultiSelect:=True)

' si aucun choix effectué, sortie du programme
If TypeName(nomfich) = "Boolean" Then
'MsgBox("Aucun fichier n'a été sélectionné. Fin de la procédure", vbCritical
+ vbOKOnly,"Sortie")
Exit Sub
End If

' si choix
Dim rep As Long
Dim Liste As String
Dim compteur As Byte
Dim Sh As Worksheet
Dim Ligne1 As Long
Dim Ligne2 As Long
Set Sh = ActiveSheet
For compteur = 1 To UBound(nomfich)
Liste = Liste & vbCr & nomfich(compteur)
Next compteur
'affichage de l'ensemble de la liste des fichiers et proposition d
'ouverture
rep = MsgBox("Voici la liste des fichiers CEXP sélectionnés." _
& Liste & vbCr & "Voulez-vous les ouvrir ?", vbYesNo + vbQuestion, "Ouvrir
les fichiers CEXP ?")
'ouverture des fichiers en cas de réponse positive
If rep = vbYes Then
For compteur = 1 To UBound(nomfich)
Workbooks.Open Filename:=nomfich(compteur)
On Error Resume Next
ligne = Sh.Cells.Find("*", [A1], , , , xlPrevious).Row + 1
If Err.Number <> 0 Then
Err.Clear
ligne = 1
End If
On Error GoTo 0
ActiveSheet.UsedRange.Copy Sh.Cells(ligne, 1)
Next compteur
ActiveWorkbook.Close False
End If
End Sub

--
Cordialement.
Daniel
"fetnat" <fetnat@caramail.com> a écrit dans le message de news:
uZ0s6PGLJHA.3412@TK2MSFTNGP05.phx.gbl...

Bonjour Daniel.C

Merci pour l'aide

Je me débat depuis ce matin, mais je bloque avec une erreur sur
Ligne = Sh.Cells.Find("*", [A1], , , , xlPrevious).Row + 1

"Var objet ou var de bloc With non definie"

A ce moment c'est le nouveau classeur qui a pour nom monfic.txt (avec une
seule page contenant mes données texte) qui est actif.
Sh.Cells.Find ne s'applique pas. J'ai essayé des variantes qui ne passent
pas, et de toutes façons une fois que j'aurais la var Ligne, il faudra que
je revienne sur mon classeur original pour faire le paste,
puis je dois fermer le classeur relais avec le texte.

Le but c'est de récupérer plusieurs fichiers textes, chacun dans une page
d'un seul classeur maître.

Je rame en toute cordialité...

Fetnat


Daniel.C a écrit :

Bonsoir.
Essaie :

Sub multiselection()
' Affichage de la boîte de dialogue standard "Ouvrir" pour sélection
de(s) fichier (s)
nomfich = Application.GetOpenFilename(Title:="Ouverture des fichiers
CEXP", MultiSelect:=True)

' si aucun choix effectué, sortie du programme
If TypeName(nomfich) = "Boolean" Then
'MsgBox("Aucun fichier n'a été sélectionné. Fin de la procédure",
vbCritical + vbOKOnly,"Sortie")
Exit Sub
End If

' si choix
Dim rep As Long
Dim Liste As String
Dim compteur As Byte
Dim Sh As Worksheet
Dim Ligne1 As Long
Dim Ligne2 As Long
Set Sh = ActiveSheet
For compteur = 1 To UBound(nomfich)
Liste = Liste & vbCr & nomfich(compteur)
Next compteur
'affichage de l'ensemble de la liste des fichiers et proposition d
'ouverture
rep = MsgBox("Voici la liste des fichiers CEXP sélectionnés." _
& Liste & vbCr & "Voulez-vous les ouvrir ?", vbYesNo + vbQuestion,
"Ouvrir les fichiers CEXP ?")
'ouverture des fichiers en cas de réponse positive
If rep = vbYes Then
For compteur = 1 To UBound(nomfich)
Workbooks.Open Filename:=nomfich(compteur)
Ligne = Sh.Cells.Find("*", [A1], , , , xlPrevious).Row + 1
ActiveSheet.UsedRange.Copy Sh.Cells(Ligne, 1)
Next compteur
ActiveWorkbook.Close False
End If
End Sub

Nos posts viennent de se croiser. Dans ma macro, chaque fichier est copié
dans le classeur qui contient la macro, sur la même feuille, les données
s'ajoutant les unes sous les autres.
--
Cordialement.
Daniel
"fetnat" <fetnat@caramail.com> a écrit dans le message de news:
O0ZQCCHLJHA.3744@TK2MSFTNGP06.phx.gbl...

J'ai la boucle finale qui ajoute une feuille et qui copie le fichier texte
sans ouvrir un classeur intermediaire.
J'ai les grandes lignes, encore quelques détails à revoir.


If rep = vbYes Then
For compteur = 1 To UBound(nomfich)
fich = nomfich(compteur)
'fich = Application.GetOpenFilename("Fichiers
txt(*.txt),*.txt") ' sans selection manuelle
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fich,
Destination:=Range("A1"))
.Name = fich '"MesDonnées"
.TextFileSpaceDelimiter = False
.Refresh BackgroundQuery:úlse
End With
ActiveWorkbook.Sheets.Add
Next compteur
ActiveWorkbook.Close True
End If

Encore merci pour m'avoir montré la voie.

Cordialement

Fetnat


fetnat a écrit :

Bonjour Daniel.C

Merci pour l'aide

Je me débat depuis ce matin, mais je bloque avec une erreur sur
Ligne = Sh.Cells.Find("*", [A1], , , , xlPrevious).Row + 1

"Var objet ou var de bloc With non definie"

A ce moment c'est le nouveau classeur qui a pour nom monfic.txt (avec une
seule page contenant mes données texte) qui est actif.
Sh.Cells.Find ne s'applique pas. J'ai essayé des variantes qui ne passent
pas, et de toutes façons une fois que j'aurais la var Ligne, il faudra
que je revienne sur mon classeur original pour faire le paste,
puis je dois fermer le classeur relais avec le texte.

Le but c'est de récupérer plusieurs fichiers textes, chacun dans une page
d'un seul classeur maître.

Je rame en toute cordialité...

Fetnat


Daniel.C a écrit :

Bonsoir.
Essaie :

Sub multiselection()
' Affichage de la boîte de dialogue standard "Ouvrir" pour sélection
de(s) fichier (s)
nomfich = Application.GetOpenFilename(Title:="Ouverture des fichiers
CEXP", MultiSelect:=True)

' si aucun choix effectué, sortie du programme
If TypeName(nomfich) = "Boolean" Then
'MsgBox("Aucun fichier n'a été sélectionné. Fin de la procédure",
vbCritical + vbOKOnly,"Sortie")
Exit Sub
End If

' si choix
Dim rep As Long
Dim Liste As String
Dim compteur As Byte
Dim Sh As Worksheet
Dim Ligne1 As Long
Dim Ligne2 As Long
Set Sh = ActiveSheet
For compteur = 1 To UBound(nomfich)
Liste = Liste & vbCr & nomfich(compteur)
Next compteur
'affichage de l'ensemble de la liste des fichiers et proposition d
'ouverture
rep = MsgBox("Voici la liste des fichiers CEXP sélectionnés." _
& Liste & vbCr & "Voulez-vous les ouvrir ?", vbYesNo + vbQuestion,
"Ouvrir les fichiers CEXP ?")
'ouverture des fichiers en cas de réponse positive
If rep = vbYes Then
For compteur = 1 To UBound(nomfich)
Workbooks.Open Filename:=nomfich(compteur)
Ligne = Sh.Cells.Find("*", [A1], , , , xlPrevious).Row + 1
ActiveSheet.UsedRange.Copy Sh.Cells(Ligne, 1)
Next compteur
ActiveWorkbook.Close False
End If
End Sub

Bonjour Daniel

Une fois de plus merci pour la variante.
C'est toujours intéressant d'avoir des alternatives.

Je dois encore trouver l'ordre le plus judicieux pour créer mon index
hyperlinké et pour remplir les feuilles.

A terme le classeur devrait permettre de choisir son répertoire et le
type de fichier (txt, doc...) puis de créer un index avec lien
hypertexte vers la feuille qui contient le texte du document.

Encore quelques heures de travail devant moi.

Cordialement

Fetnat


Daniel.C a écrit :

Au temps pour moi. Ca plante quand la feuille réceptrice est vierge; voici
la macro corrigée :

Sub multiselection()
' Affichage de la boîte de dialogue standard "Ouvrir" pour sélection de(s)
fichier (s)
nomfich = Application.GetOpenFilename(Title:="Ouverture des fichiers CEXP",
MultiSelect:=True)

' si aucun choix effectué, sortie du programme
If TypeName(nomfich) = "Boolean" Then
'MsgBox("Aucun fichier n'a été sélectionné. Fin de la procédure", vbCritical
+ vbOKOnly,"Sortie")
Exit Sub
End If

' si choix
Dim rep As Long
Dim Liste As String
Dim compteur As Byte
Dim Sh As Worksheet
Dim Ligne1 As Long
Dim Ligne2 As Long
Set Sh = ActiveSheet
For compteur = 1 To UBound(nomfich)
Liste = Liste & vbCr & nomfich(compteur)
Next compteur
'affichage de l'ensemble de la liste des fichiers et proposition d
'ouverture
rep = MsgBox("Voici la liste des fichiers CEXP sélectionnés." _
& Liste & vbCr & "Voulez-vous les ouvrir ?", vbYesNo + vbQuestion, "Ouvrir
les fichiers CEXP ?")
'ouverture des fichiers en cas de réponse positive
If rep = vbYes Then
For compteur = 1 To UBound(nomfich)
Workbooks.Open Filename:=nomfich(compteur)
On Error Resume Next
ligne = Sh.Cells.Find("*", [A1], , , , xlPrevious).Row + 1
If Err.Number <> 0 Then
Err.Clear
ligne = 1
End If
On Error GoTo 0
ActiveSheet.UsedRange.Copy Sh.Cells(ligne, 1)
Next compteur
ActiveWorkbook.Close False
End If
End Sub