Ouvrir des fichier txt a partir d'un fichier Excel en VBA

Bonjour

J'ai un fichier excel tbt et j'aimerais avoir une macro( qui m'ouvrira tout seul des fichiers txt qui sont situer tous au même endroit sur le bureau). et sur ces fichiers txt j'effectue d'autre macro(du style des opération ) qui se placeront dans mon fichier excel tbt.

sachant que j'ai tout les mois des nouveaux fichiers txt (au moins 60) j'aimerais automatiser ce travail mais je vois pas du tout comment faire cette macro

Merci infiniment pour votre précieuse aide

bonjour,

merci de mettre des fichiers exemple (TXT, TBT) ainsi que les opérations que tu ferais manuellement pour obtenir le résultat que tu veux automatiser.

voici mon fichier tbt (ceux que je veux remplir c les onglet jaune) et un des fichier txt (tout les moi j'en ai un, la j'ai fait seulement pour 1 seul contrat )

voici les macro que j'ai fait jusqu'a maintenant je convertisser mon fichier txt en excel j'effectuer les macro et après je coller sur mon fichier tbt

Sub NOMBRE_ADHESION_TECHNIQUE()

    Dim Date_Souscription_Adhésion As Range
    Dim DernLigne As Long
    Dim nblignes(1 To 12, 2013 To 2017) As Long
    Dim i, j, k As Integer
    Dim a, b, c, d, e As Integer

    With Worksheets("Sinistre_101")
        DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Date_Souscription_Adhésion = .Range("F2:F" & DernLigne)
    End With

    a = LBound(nblignes, 2)
    e = UBound(nblignes, 2)

    For i = 2 To DernLigne
        j = Month(Cells(i, 6).Value)
        k = Year(Cells(i, 6).Value)
        nblignes(j, k) = nblignes(j, k) + 1
    Next i

    For i = 1 To 12
        For k = a To e
            Sheets("Feuil1").Cells(i + (k - 2013) * 12, 2).Value = nblignes(i, k)
        Next k
    Next i

End Sub
Sub NOMBRE_DE_SINISTRES_DECLARES()

    Dim Date_Souscription_Adhésion As Range, Date_Survenance As Range
    Dim DernLigne As Long
    Dim nblignes(1 To 12, 2013 To 2017) As Long
    Dim i, j, k As Integer
    Dim a, b, c, d, e As Integer

    With Worksheets("Sinistre_101")
        DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
        Set Date_Survenance = .Range("U2:U" & DernLigne)
    End With

    a = LBound(nblignes, 2)
    e = UBound(nblignes, 2)

    For i = 2 To DernLigne
       If a <= Year(Cells(i, 21).Value) And Year(Cells(i, 21).Value) <= e Then
            j = Month(Cells(i, 7).Value)
            k = Year(Cells(i, 7).Value)
            nblignes(j, k) = nblignes(j, k) + 1
        End If
    Next i

    For i = 1 To 12
        For k = a To e
            Sheets("Feuil1").Cells(i + (k - 2013) * 12, 3).Value = nblignes(i, k)
        Next k
    Next i

End Sub
Sub NOMBRE_DE_SINISTRES_ACCEPTES()

    Dim Date_Souscription_Adhésion As Range, Date_Survenance, Statut_Technique_Sinistre As Range
    Dim DernLigne As Long
    Dim nblignes(1 To 12, 2013 To 2017) As Long
    Dim i, j, k As Integer
    Dim a, b, c, d, e As Integer
    Dim s As String

    With Worksheets("Sinistre_101")
        DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
        Set Date_Survenance = .Range("U2:U" & DernLigne)
        Set Statut_Technique_Sinistre = .Range("V2:V" & DernLigne)
    End With

    a = LBound(nblignes, 2)
    e = UBound(nblignes, 2)

    For i = 2 To DernLigne
        s = Cells(i, "V").Value
        If s = "Terminé - accepté" Then
            If a <= Year(Cells(i, 21).Value) And Year(Cells(i, 21).Value) <= e Then
                j = Month(Cells(i, 7).Value)
                k = Year(Cells(i, 7).Value)
                nblignes(j, k) = nblignes(j, k) + 1
            End If
        End If
    Next i

    For i = 1 To 12
        For k = a To e
            Sheets("Feuil1").Cells(i + (k - 2013) * 12, 4).Value = nblignes(i, k)
        Next k
    Next i

End Sub
Sub Taux_Accp()

    Dim Sinistre_Accepte As Range
    Dim Sinistre_Declare As Range
    Dim DernLigne1 As Long
    Dim i As Integer

    With Worksheets("Feuil1")
        DernLigne1 = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Sinistre_Accepte = .Range("D1:D" & DernLigne1)
        Set Sinistre_Declare = .Range("C1:C" & DernLigne1)
    End With

'Total = Nombre_Sinistre_Accepte / Nombre_Sinistre_Declare

    For i = 2 To DernLigne1
        If Cells(i, 3).Value = 0 Then
            Cells(i, 5).Value = 0
        Else
            Cells(i, 5).Value = Cells(i, 4).Value / Cells(i, 3).Value
        End If
    Next i

End Sub
Sub MONTANT_INDEMNITE_PRINCIPALE()

    Dim Date_Souscription_Adhésion As Range, Statut_Technique_Sinistre As Range
    Dim Montant_Ind_Principale As Range
    Dim DernLigne As Long
    Dim i As Integer
    Dim sa As String
    Dim montant As String
    Dim tt(2013 To 2017, 1 To 12) As Double
    'tmois = Split("janvier,février,mars,avril,mai,juin,juillet,août,septembre,octobre,novembre,décembre", ",")

    With Worksheets("Sinistre_101")
        DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
        Set Montant_Ind_Principale = .Range("AB2:AB" & DernLigne)
        Set Statut_Technique_Sinistre = .Range("V2:V" & DernLigne)

    For i = 2 To DernLigne
        sa = .Cells(i, 22)
        montant = Replace(.Cells(i, 28), ".", ",")
        annee = Year(.Cells(i, 7).Value)
        Mois = Month(.Cells(i, 7).Value)
        If sa <> "Terminé - Refusé après instruction" Then
            tt(annee, Mois) = tt(annee, Mois) + CDbl(montant)
        End If
    Next i

    For annee = 2013 To 2017
        For Mois = 1 To 12
            j = j + 1
           ' Sheets("Feuil2").Cells(j, 2).Value = tmois(Mois - 1) & " " & annee
            Sheets("Feuil1").Cells(j, 6).Value = tt(annee, Mois)
        Next Mois
    Next annee

    End With

End Sub

Sub MONTANT_FRAIS_ANNEXE()

    Dim Date_Souscription_Adhésion As Range, Statut_Technique_Sinistre As Range
    Dim Frais_Annexe As Range
    Dim DernLigne As Long
    Dim i As Integer
    Dim sa As String
    Dim frais As String
    Dim tt(2013 To 2017, 1 To 12) As Double

    With Worksheets("Sinistre_101")
        DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
        Set Frais_Annexe = .Range("AC2:AC" & DernLigne)
        Set Statut_Technique_Sinistre = .Range("V2:V" & DernLigne)

    For i = 2 To DernLigne
        sa = .Cells(i, 22)
        frais = Replace(.Cells(i, 29), ".", ",")
        annee = Year(.Cells(i, 7).Value)
        Mois = Month(.Cells(i, 7).Value)
        If sa <> "Terminé - Refusé après instruction" Then
           tt(annee, Mois) = tt(annee, Mois) + CDbl(frais)
        End If
    Next i

    For annee = 2013 To 2017
        For Mois = 1 To 12
            j = j + 1
            Sheets("Feuil1").Cells(j, 7).Value = tt(annee, Mois)
        Next Mois
    Next annee

    End With

End Sub
Sub MONTANT_REPRISE()

    Dim Date_Souscription_Adhésion As Range, Statut_Technique_Sinistre As Range
    Dim Somme_Montant_Reprise As Range
    Dim DernLigne As Long
    Dim i As Integer
    Dim sa As String
    Dim reprise As String
    Dim tt(2013 To 2017, 1 To 12) As Double

    With Worksheets("Sinistre_101")
        DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
        Set Somme_Montant_Reprise = .Range("AD2:AD" & DernLigne)
        Set Statut_Technique_Sinistre = .Range("V2:V" & DernLigne)

    For i = 2 To DernLigne
        sa = .Cells(i, 22)
        reprise = Replace(.Cells(i, 30), ".", ",")
        annee = Year(.Cells(i, 7).Value)
        Mois = Month(.Cells(i, 7).Value)
        If sa <> "Terminé - Refusé après instruction" Then
           tt(annee, Mois) = tt(annee, Mois) + CDbl(reprise)
        End If
    Next i

    For annee = 2013 To 2017
        For Mois = 1 To 12
            j = j + 1
            Sheets("Feuil1").Cells(j, 8).Value = tt(annee, Mois)
        Next Mois
    Next annee

    End With

End Sub
Sub MONTANT_TOTAL_REGLEMENT()

    Dim Date_Souscription_Adhésion As Range, Statut_Technique_Sinistre As Range
    Dim Somme_Montant_Total_Reglement As Range
    Dim DernLigne As Long
    Dim i As Integer
    Dim sa As String
    Dim total As String
    Dim tt(2013 To 2017, 1 To 12) As Double

    With Worksheets("Sinistre_101")
        DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
        Set Somme_Montant_Total_Reglement = .Range("AE2:AE" & DernLigne)
        Set Statut_Technique_Sinistre = .Range("V2:V" & DernLigne)

    For i = 2 To DernLigne
        sa = .Cells(i, 22)
        total = Replace(.Cells(i, 31), ".", ",")
        annee = Year(.Cells(i, 7).Value)
        Mois = Month(.Cells(i, 7).Value)
        If sa <> "Terminé - Refusé après instruction" Then
            tt(annee, Mois) = tt(annee, Mois) + CDbl(total)
        End If
    Next i

    For annee = 2013 To 2017
        For Mois = 1 To 12
            j = j + 1
            Sheets("Feuil1").Cells(j, 9).Value = tt(annee, Mois)
        Next Mois
    Next annee

    End With

End Sub
Sub CHARGES_SINISTRES_REFUSE()

    Dim Date_Souscription_Adhésion As Range, Statut_Technique_Sinistre As Range
    Dim Frais_Annexe As Range
    Dim DernLigne As Long
    Dim i As Integer
    Dim sa As String
    Dim refus As String
    Dim tt(2013 To 2017, 1 To 12) As Double

    With Worksheets("Sinistre_101")
        DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
        Set Frais_Annexe = .Range("AC2:AC" & DernLigne)
        Set Statut_Technique_Sinistre = .Range("V2:V" & DernLigne)

    For i = 2 To DernLigne
        sa = .Cells(i, 22)
        refus = Replace(.Cells(i, 29), ".", ",")
        annee = Year(.Cells(i, 7).Value)
        Mois = Month(.Cells(i, 7).Value)
        If sa = "Terminé - Refusé après instruction" Then
           tt(annee, Mois) = tt(annee, Mois) + CDbl(refus)
        End If
    Next i

    For annee = 2013 To 2017
        For Mois = 1 To 12
            j = j + 1
            Sheets("Feuil1").Cells(j, 10).Value = tt(annee, Mois)
        Next Mois
    Next annee

    End With

End Sub
Sub fraisgeneraux()

End Sub
Sub participationaubenefice()

End Sub

Sub Resultat_Net_AVEC_ICI()

    Dim Prime_ICI As Range
    Dim Somme_Montant_Total_Reglement As Range
    Dim i As Integer
    Dim DernLigne As Long

    With Worksheets("Feuil1")
        DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Prime_ICI = .Range("R1:R" & DernLigne)
        Set Somme_Montant_Total_Reglement = .Range("I1:I" & DernLigne)
    End With

    For i = 1 To DernLigne
       'Resultat_Net_ICI = Prime_ICI - Somme_Montant_Total_Reglement
        Cells(i, 13).Value = Cells(i, 18).Value - Cells(i, 9).Value
    Next i

End Sub
Sub Resultat_Net_SANS_ICI()

    Dim Prime_SANS_ICI As Range
    Dim Somme_Montant_Total_Reglement As Range
    Dim i As Integer
    Dim DernLigne As Long

    With Worksheets("Feuil1")
        DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Prime_SANS_ICI = .Range("S1:S" & DernLigne)
        Set Somme_Montant_Total_Reglement = .Range("I1:I" & DernLigne)
    End With

    For i = 1 To DernLigne
       'Resultat_Net_SANS_ICI = Prime_SANS_ICI - Somme_Montant_Total_Reglement
        Cells(i, 14).Value = Cells(i, 19).Value - Cells(i, 9).Value
    Next i

End Sub
Sub Sinistre_Sur_Prime_ici()

    Dim Somme_Montant_Total_Reglement As Range
    Dim Prime_ICI As Range
    Dim Sinistre_Sur_Prime_ici As Double
    Dim DernLigne As Long
    Dim i As Integer

    With Worksheets("Feuil1")
        DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Prime_ICI = .Range("R1:R" & DernLigne)
        Set Somme_Montant_Total_Reglement = .Range("I1:I" & DernLigne)
    End With

    For i = 2 To DernLigne
        'Sinistre_Sur_Prime_ICI = Somme_Montant_Total_Reglement / Prime_ICI
         Cells(i, 15).Value = Cells(i, 9).Value / Cells(i, 18).Value
    Next i

End Sub
Sub Sinistre_Sur_Prime_sans_ici()

    Dim Somme_Montant_Total_Reglement As Range
    Dim Prime_SANS_ICI As Range
    Dim Sinistre_Sur_Prime_sans_ici As Double
    Dim DernLigne As Long
    Dim i As Integer

    With Worksheets("Feuil1")
        DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Prime_SANS_ICI = .Range("S1:S" & DernLigne)
        Set Somme_Montant_Total_Reglement = .Range("I1:I" & DernLigne)
    End With

    For i = 2 To DernLigne
        'Sinistre_Sur_Prime_SANS_ICI = Somme_Montant_Total_Reglement / Prime_SANS_ICI
         Cells(i, 16).Value = Cells(i, 9).Value / Cells(i, 19).Value
    Next i

End Sub

Sub Generation2()

    Dim DernLigne As Long
    Dim i As Integer

    With Sheets("Sinistre_Historique_ICIMM102_30")
        DernLigne = .Cells(Rows.Count, 2).End(xlUp).Row

        For i = 2 To DernLigne
            ' date souscription + durée de garantie > date de survenance
          If .Cells(i, 7) + .Cells(i, 16) > .Cells(i, 21) Then
                Sheets("Feuil1").Cells(i, 17).Value = "oui"
            Else
                Sheets("Feuil1").Cells(i, 17).Value = "non"
            End If
        Next i
    End With
End Sub

merci beaucoup pour ton aide

51tdb-exple.xlsx (200.64 Ko)

bonjour,

voici un macro qui ouvre les fichiers txt d'un répertoire donné et qui les copies sur une feuille dans le fichier contenant la macro.

Sub aargh()
    Path = "repertoire des fichiers txt terminé par un /"
    Set twb = ThisWorkbook
    fn = Dir(Path & "*.txt")
    While fn <> ""
        Workbooks.OpenText Filename:= _
                           Path & fn, Origin:=xlWindows _
                            , StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                           ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
                            , Space:=False, Other:=False
        Set wbtxt = ActiveWorkbook
        wbtxt.Sheets(1).Copy after:=twb.Worksheets(Worksheets.Count)
        wbtxt.Close
        fn = Dir()
    Wend
End Sub

alors la mercii bcp mais pourrais tu m'expliquer comment tu as fais je comprend pas trop le code

sa marche mais y a un petit pb tout vient en txt mais le fichier est incompréhensible parce que moi quand je le convertis en excel je fais pour séparateur point virgule et tabulation

aude21 a écrit :

sa marche mais y a un petit pb tout vient en txt mais le fichier est incompréhensible parce que moi quand je le convertis en excel je fais pour séparateur point virgule et tabulation

re bonjour,

tu mets semicolon:=true dans l'instruction opentext

c'est ceux que j'ai fait mais je cmprend pas pq il me prend tt en decaler

rien est a leur place


comment je pourrais faire en sorte qu'il accepte les virgules


accent pardon


comment je pourrais faire aussi que sil ya des date qui saffiche sa s'affiche au format jj/mm/aa parce que la sa s'affiche en mm/jj/aa

re-bonjour,

peux-tu faire un effort pour écrire correctement et respecter la charte du forum s'il-te-plaît ?

peux-tu mettre un exemple de fichier TXT "qui se lit mal" ? je n'ai pas de problème avec le fichier que tu as posté sur le forum.

oui désolée

re-bonjour

j'ai trouver mon erreur pour le format de la date j'ai utiliser FieldInfo et j'ai donné la valeurs 4 pour la colonne correspondant à une date

cependant je ne vois pas comment faire pour qu'il accepte les accents

merci de votre aide



désolé je me suis trompé de fichier

ce fichier n'est pas différent de celui que tu as mis précédemment.

c'est le deuxième j'ai rajouté une colonne ou il y a des mots avec accents par exemple pour Critere_Tarifaire_2

aude21 a écrit :

c'est le deuxième j'ai rajouté une colonne ou il y a des mots avec accents par exemple pour Critere_Tarifaire_2

pas de problème pour lire les accents quand il y en a

pas d'accent sur critere_tarifaire dans le fichier txt.

sur la colonne du critaire tarifaire

Ta pas de problemes d'accent? moi il menvoie les mots mais a la place du é j'ai ã

bonsoir,

essaie avec le paramètre suivant dans opentext

Origin:=65001,

Bonjour,

Merci beaucoup h2so4 ça marche très bien

Rechercher des sujets similaires à "ouvrir fichier txt partir vba"