Concaténation de deux fichiers VBA

Résolu
mimi_1990 Messages postés 99 Statut Membre -  
mimi_1990 Messages postés 99 Statut Membre -
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.

2 réponses

  1. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    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+
    0
  2. mimi_1990 Messages postés 99 Statut Membre 15
     
    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
    0