Concaténation de deux fichiers VBA

Résolu/Fermé

mimi_1990 Messages postés 75 Date d'inscription jeudi 1 juillet 2010 Statut Membre Dernière intervention 15 novembre 2010 - Modifié par mimi_1990 le 1/07/2010 à 17:26
mimi_1990 Messages postés 75 Date d'inscription jeudi 1 juillet 2010 Statut Membre Dernière intervention 15 novembre 2010 - 2 juil. 2010 à 11:26

Bonjour,

J'ai crée ce code dans mon Userform afin d'ouvrir sous excel des fichiers .txt sélectionner par un bouton parcourir.

code: 

Private Sub OK_Click() 
    Workbooks.OpenText Filename:= _ 
        Réel.selection.Text, _ 
        Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ 
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _ 
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _ 
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _ 
        Array(9, 1), Array(10, 1)), DecimalSeparator:=",", TrailingMinusNumbers:=True 
    Unload Réel 
End Sub 

Private Sub Parcourir_Click() 
    Réel.selection.Text = "" 
    'Demande de selection des fichiers 
    With Application.FileDialog(msoFileDialogOpen) 
        .AllowMultiSelect = True 
        .Show 
        For i = 1 To .SelectedItems.Count 
            Réel.selection.Text = Réel.selection.Text + .SelectedItems(i) + vbCrLf 
        Next i 
    End With 
End Sub

Je suis Nouveau sur VBA et ne sait donc pas comment faire cela:
Lorsque je ne selectionne qu'un seul fichier avec mon bouton parcourir le macro me l'ouvre et il n'y a aucun souci.
En revanche il y a un souci lorsque je selectionne plusieurs fichier( les fichiers ouverts seront toujours des .txt comprtants plusieurs lignes comme celle ci:
JJ/MM/AAAA;BERNARD_HENRY;#######;#####;#####;###########;type_de_produit;##,##;###;#######. (informations réelle ne pouvant etre divulguée.

J'aimerai qu'il m'ouvre les n-fichiers les uns à la suite des autres sur la meme worksheet.
J'aimerai également savoir comment utiliser une listbox pour la meme chose a la place de la textbox je n'arrive pas a comprendre comment la listbox fonctionne... :s
Je suis désolé si je ne suis pas très explicite mais je ne sais pas trop comment m'exprimer.
J'espère que vous me comprendrez, D'avance merci.

A voir également:

Concaténation de deux fichiers VBA
Wetransfer gratuit fichiers lourd - Guide
Deux comptes whatsapp - Guide
Fusionner deux fichiers excel - Guide
Explorateur de fichiers - Guide
Concatener deux cellules excel - Guide

2 réponses

Réponse 1 / 2

lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
1 juil. 2010 à 17:58

Bonjour,
Tu dois mettre les fichiers supplementaires sur les dernières ligne vides.
Tu met ton 1er texte sur.. ex: A3
ton second fichier decrait être sur la ligne
(supposons la feuille "Feuil1")
dim Lig

Lig = 1 'Première ligne où écrire
... Ton code avec  StartRow:=Lig
Private Sub OK_Click() 
    Lig = range("A1").End(Xlup).Row + 1
    ....

Si c'est pas clair tu dis.
A+

Réponse 2 / 2

mimi_1990 Messages postés 75 Date d'inscription jeudi 1 juillet 2010 Statut Membre Dernière intervention 15 novembre 2010 15
2 juil. 2010 à 11:26

Salut,

Merci pour ta réponse mais j'ai finalement trouvé en faisant autrement !
Tout d'abord j'ai réussi a changé ma textbox en listbox ce qui m'a aidé.
Ensuite ta réponse m'a fait pensé a simplement créer une fonction copier/coller.
Après le choix des deux fichiers le programme colle le premier en dessous du second et tout va bien !

voici mon code pour ceux que ca interesse.

d'abord celui de la fonction:

Function copiercoller(aws As Worksheet, file As String, ByVal from As Integer)
    Dim ws As Worksheet
        Workbooks.OpenText Filename:= _
            file, _
            Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
            xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
            Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
            Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
            Array(9, 1), Array(10, 1)), DecimalSeparator:=",", TrailingMinusNumbers:=True
    For Each ws In ActiveWorkbook.Worksheets
        ' A row for reference to the source file
        Dim memfrom As Integer
        memfrom = from
        ' Copy/Paste
        Range(ws.Cells(1, 1), ws.Cells.SpecialCells(xlLastCell)).Copy
        aws.Paste Destination:=aws.Cells(from, 1)
        ' calculate next line
        from = from + ws.Cells.SpecialCells(xlLastCell).Row
    Next ws
    ActiveWorkbook.Close Savechanges:=False
    copiercoller = from
End Function

Voici celui de ma commande ok qui appelle la fonction:

Private Sub OK_Click()
    pl = 1
    For i = 1 To Réel.selection.ListCount
    pl = copiercoller(Application.ThisWorkbook.ActiveSheet, Réel.selection.List(i - 1), pl)
    Next i
    Unload Réel
End Sub

Voilaaa

Discussions similaires

Un seul de mes écouteurs marche. Que faire ?

comment donner les droits sur fichier partage

ouverture d'un fichier excel à partir d'un code VBA

Chemin Logo du site de la Cité de l'espace

Discussions similaires

Newsletters