Concaténation de deux fichiers VBA

Résolu/Fermé
Signaler
Messages postés
75
Date d'inscription
jeudi 1 juillet 2010
Statut
Membre
Dernière intervention
15 novembre 2010
-
Messages postés
75
Date d'inscription
jeudi 1 juillet 2010
Statut
Membre
Dernière intervention
15 novembre 2010
-
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

Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
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+
Messages postés
75
Date d'inscription
jeudi 1 juillet 2010
Statut
Membre
Dernière intervention
15 novembre 2010
14
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