Microsoft 365 Copier / coller données spécifiques documents txt vers Excel

Derrdio · 20 Septembre 2023

Bonjour à tous,

Je débute en VBA, j'aimerai sélectionner certaines données de fichiers txt pour les replacer dans une feuille Excel. J'ai plusieurs fichier txt dans le même dossier avec la même construction (même type de donnée au même endroit). Le but est de copier coller :
- la ligne 18 colonne 2 à 11 dans la case A2
- la ligne 16 colonne 1 à 20 dans la case B2
- la ligne 21 colonne 2 à 9 dans la case C2
- la ligne 34 colonne 2 à 18 dans la case D2
- la ligne 38 colonne 2 à 6 dans la case E2
- la ligne 45 colonne 1 à 4 dans la case F2
- la ligne 53 colonne 2 à 18 dans la case G2
Le tout en passant à chaque fois à ligne suivante (A3,B3,C3...) à chaque document pour faire un tableau. Je précise que les documents txt sont en utf-8. Je ne mets pas de code car les essais passés sont infructueux.
Merci d'avance

Derrdio · 20 Septembre 2023

Re,

J'ai au final réussi en adaptant des bouts de code par-ci par-là. Je mets le code si des fois des personnes ont les mêmes besoins.

VB:

Sub ImporterDonneesTxtAvecDialogue()

    Dim MonDossier As String
    Dim MonFichier As String
    Dim CheminComplet As String
    Dim MonWb As Workbook
    Dim DerniereLigne As Long
    Dim i As Long
    
    ' Affiche une boîte de dialogue pour sélectionner le dossier
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Sélectionnez le dossier contenant les fichiers texte"
        If .Show = -1 Then
            MonDossier = .SelectedItems(1) & "\"
        Else
            MsgBox "Aucun dossier sélectionné. L'opération a été annulée."
            Exit Sub
        End If...

Oneida · 20 Septembre 2023

Bonjour,

Je ne mets pas de code car les essais
Oui, mais un ou deux fichiers txt seraient bienvenus

Derrdio · 20 Septembre 2023

Re,

J'ai au final réussi en adaptant des bouts de code par-ci par-là. Je mets le code si des fois des personnes ont les mêmes besoins.

VB:

Sub ImporterDonneesTxtAvecDialogue()

    Dim MonDossier As String
    Dim MonFichier As String
    Dim CheminComplet As String
    Dim MonWb As Workbook
    Dim DerniereLigne As Long
    Dim i As Long
    
    ' Affiche une boîte de dialogue pour sélectionner le dossier
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Sélectionnez le dossier contenant les fichiers texte"
        If .Show = -1 Then
            MonDossier = .SelectedItems(1) & "\"
        Else
            MsgBox "Aucun dossier sélectionné. L'opération a été annulée."
            Exit Sub
        End If
    End With
    
    ' Définissez la première ligne d'Excel
    DerniereLigne = 2
    
    ' Activez l'application Excel pour éviter que les messages d'alerte ne s'affichent
    Application.ScreenUpdating = False
    
    ' Parcourez tous les fichiers texte dans le dossier spécifié
    MonFichier = Dir(MonDossier & "*.txt")
    Do While MonFichier <> ""
        CheminComplet = MonDossier & MonFichier
        
        ' Ouvrez le fichier texte
        Workbooks.OpenText Filename:=CheminComplet, Origin:=437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), Array(18, 2), Array(38, 1), Array(58, 1), Array(76, 2), Array(96, 2), Array(118, 2), Array(136, 1), Array(154, 2), Array(172, 2), Array(192, 1), Array(212, 2), Array(230, 2), Array(250, 2), Array(270, 1), Array(288, 2), Array(306, 2), Array(326, 2), Array(346, 2), Array(366, 2))
        
        ' Copiez les données du fichier texte dans la feuille Excel
        Set MonWb = Workbooks(MonFichier)
        ThisWorkbook.Sheets(2).Cells(DerniereLigne, 1).Value2 = MonWb.Sheets(1).Cells(18, 1).Resize(1, 9).Value2
        ThisWorkbook.Sheets(2).Cells(DerniereLigne, 2).Value2 = MonWb.Sheets(1).Cells(16, 1).Resize(1, 50).Value2
        ThisWorkbook.Sheets(2).Cells(DerniereLigne, 3).Value2 = MonWb.Sheets(1).Cells(21, 1).Resize(1, 7).Value2
        ThisWorkbook.Sheets(2).Cells(DerniereLigne, 4).Value2 = MonWb.Sheets(1).Cells(34, 1).Resize(1, 50).Value2
        ThisWorkbook.Sheets(2).Cells(DerniereLigne, 5).Value2 = MonWb.Sheets(1).Cells(38, 1).Resize(1, 5).Value2
        ThisWorkbook.Sheets(2).Cells(DerniereLigne, 6).Value2 = MonWb.Sheets(1).Cells(45, 1).Resize(1, 3).Value2
        ThisWorkbook.Sheets(2).Cells(DerniereLigne, 7).Value2 = MonWb.Sheets(1).Cells(53, 1).Resize(1, 10).Value2
        
        ' Fermez le fichier texte
        MonWb.Close SaveChanges:=False
        
        ' Passez à la ligne suivante dans Excel
        DerniereLigne = DerniereLigne + 1
        
        ' Passez au fichier texte suivant
        MonFichier = Dir
    Loop
    
    ' Réactivez la mise à jour de l'application Excel
    Application.ScreenUpdating = True
    
    MsgBox "Importation terminée!"
End Sub

Staple1600 · 20 Septembre 2023

Bonjour le fil

@Derrdio
[Pour infos]

La Charte à dit:
1.1 - Conformité RGPD
Tout message ou fichier déposé sur ce site ne doit pas comporter de données à caractère personnel contrevenant au RGPD (Réglement Général sur la Protection des Données).
Il convient pour cela d’anonymiser toutes les données permettant d’identifier directement ou indirectement une personne physique ou morale.

Sinon puisque tu utilises Office 365, tu peux simplement utiliser PowerQuery
=> Obtenir des données/A partir d'un fichier/A partir d'un dossier/
Ce qui produit ce résultat
(ici brut de décoffrage)

L'avantage, une fois la requête créée, c'est qu'il suffit de cliquer sur Actualiser tout pour une MAJ
quand sont ajoutés de nouveaux fichiers *.txt dans le dossier source.

Microsoft 365 Copier / coller données spécifiques documents txt vers Excel

Derrdio

XLDnaute Nouveau

Derrdio

Oneida

XLDnaute Impliqué

Derrdio

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Discussions similaires