Automatisation d'une macro

Bonjour,

je vais créer un classeur avec plusieurs feuilles:

chaque nom de feuille correspond à un nom de fichier txt sur un site.

j'ai donc réalisé en vba la chose suivante:

importer le fichier txt, écrire le contenu à partir de A1.

cela fonctionne trés bien mais voila je souhaite faire la même chose pour chaque feuille:

c'est à dire utiliser le nom de la feuille comme nom de fichier txt et ensuite quelque soit la feuille mettre les données en A1.

voici mon code pour allé chercher le fichier txt:

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
    "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long

 Sub Get_File_From_FTP()
    Dim URL As String
    Dim LocalFileName As String
    Dim ErrorText As String

    URL = "http://MONSITE/Licences/REVERSIBLE.txt"
    LocalFileName = Workbooks(ActiveWorkbook.Name).Path & "\REVERSIBLE.txt"
    B = DownloadFile(UrlFileName:=URL, _
                    DestinationFileName:=LocalFileName, _
                    Overwrite:=OverwriteRecycle, _
                    ErrorText:=ErrorText)
    If B = False Then
        MsgBox "Site des licences hors ligne veuillez essayer plus tard"
    Else
       ' MsgBox "Fichier des licences chargé pour vérification " & ErrorText
    End If

End Sub

et celui pour écrire à partir de A1

Sub LireFichierTXT()

    Sheets("REVERSIBLE").Select
    Range("A1").Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    With ActiveSheet.QueryTables.Add(Connection:= _
         "TEXT;" & Workbooks(ActiveWorkbook.Name).Path & "\REVERSIBLE.txt", _
        Destination:=Range("$A$1"))
      '  .CommandType = 0
        .Name = "REVERSIBLE"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

End Sub

j'aurais donc besoin de votre aide car j'ai bien fait avec chaque feuille mais le code n'en fini plus et comme il y as réguliérement l'apport de nouvelle feuille dur dur.

à l'avance un grand merci.

Daniel

Bonjour,

à tester

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
    "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long

 Sub Get_File_From_FTP(sfile)
    Dim URL As String
    Dim LocalFileName As String
    Dim ErrorText As String

    URL = "http://MONSITE/Licences/" & sfile
    LocalFileName = Workbooks(ActiveWorkbook.Name).Path & "\" & sfile
    B = DownloadFile(UrlFileName:=URL, _
                    DestinationFileName:=LocalFileName, _
                    Overwrite:=OverwriteRecycle, _
                    ErrorText:=ErrorText)
    If B = False Then
        MsgBox "Site des licences hors ligne veuillez essayer plus tard"
    Else
       ' MsgBox "Fichier des licences chargé pour vérification " & ErrorText
    End If

End Sub

Sub LireFichierTXT()
For Each ws In Worksheets
    sfile = ws.Name & ".txt"
    Get_File_From_FTP (sfile)
    With ws.QueryTables.Add(Connection:= _
         "TEXT;" & Workbooks(ActiveWorkbook.Name).Path & "\" & sfile, _
        Destination:=ws.Range("$A$1"))
      '  .CommandType = 0
        .Name = "REVERSIBLE"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpac :btres: eDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

End Sub

un grand merci.

j'ai essayé et juste une modif à faire sinon top.

Daniel