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.
A voir également:

2 réponses

Réponse 1 / 2
lermite222 Messages postés 9042 Statut Contributeur 1 191
 
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
Réponse 2 / 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