Créer une boucle pour importer des fichiers

bonjour à tous,

je suis a la recherche d'aide pour créer une boucle sur ma macro,

pour le moment j'ai fait ma macro qui recupere des données pour les mettre dans un fichier recap,

cependant j'ai 25 fichiers et j'ai donc recopier le meme schema 25 fois, oui je sais je suis debile lol,

je sais qu'il existe un systeme de boucle avec la fonction dir mais mon probleme est le suivant :

mes fichiers sources comportent plusieurs onglets avec des noms differents, d'ou le fait que je ne sais pas comment ecrire cette boucle !!

Merci d'avance a tous pour votre aide

Bonjour et bienvenu(e)

Fournis ton fichier ainsi que la macro et explique un peu plus ton histoire de feuilles

Que tu ne connaisses pas le nom des feuilles dans lesquelles tu veux récupérer des données, possible mais tu dois bien savoir comment trouver ces feuilles (position dans le classeur, repérage dans la feuille etc .... ou tirage au sort )

Bonjour,

Une piste :

Sub Test()

    Dim Cls As Workbook
    Dim Fe As Worksheet
    Dim Tablo() As String
    Dim I As Integer

    'appel de la fonction avec le chemin du dossier (adapter...)
    Tablo = RecupFichiers("F:\")

    If Not (Not Tablo) Then

        For I = 1 To UBound(Tablo)

            'ouvre le classeur...
            Set Cls = Workbooks.Open(Tablo(I))

            'parcours sa collection de feuilles...
            For Each Fe In Cls.Worksheets

                'inscrit le nom des feuilles dans la fenêtre d'exécution (Ctrl+G)
                Debug.Print Fe.Name

                'c'est ici qu'il te faut savoir quoi faire du genre...
    '            If Fe.Name = "Le nom de ma feuille" Then
    '                MsgBox Fe.Range("A1").Value
    '            End If

            Next Fe

            'referme le classeur
            Cls.Close False

        Next I

    End If

End Sub

Function RecupFichiers(Chemin As String) As String()

    Dim Tbl() As String
    Dim Fichier As String
    Dim I As Integer

    'seulement les fichiers Excel (.xls, . xlsx, . xlsm, etc...)
    Fichier = Dir(Chemin & "*.xls*")

    Do While (Len(Fichier) > 0)

        I = I + 1
        ReDim Preserve Tbl(1 To I)
        Tbl(I) = Fichier
        Fichier = Dir()

    Loop

    RecupFichiers = Tbl()

End Function

bonjour,

Merci pour vos retours,

je vous donne un aperçu de ma macro ci-dessous,

les feuilles font parti d'un classeur avec 3 a 10 onglets max.

Sub Creationsynthese()

' effacement de la feuille

Cells.Delete

' A)fichier 1

'ouverture des fichiers

Workbooks.Open "M:\CCIE\BUDGETS\PRIMITIF\2016\préparation BP 2016 - provisoire\Appui\test\23-grille budgetaire BP 2016.xlsx"

Application.DisplayAlerts = False

'selection des données (copier coller)

Workbooks("23-grille budgetaire BP 2016.xlsx").Sheets("23 (2)").UsedRange.Select

Workbooks("23-grille budgetaire BP 2016.xlsx").Sheets("23 (2)").UsedRange.Copy

Workbooks("récap.xlsm").Activate

DebutNomFichier = ActiveSheet.UsedRange.Rows.Count

Range("A" & ActiveSheet.UsedRange.Rows.Count).Select

ActiveSheet.Paste

Application.CutCopyMode = False

Application.DisplayAlerts = False

'fermeture des fichiers

Workbooks("23-grille budgetaire BP 2016.xlsx").Close savechanges:=False

' B) fichier 2

'ouverture des fichiers

Workbooks.Open "M:\CCIE\BUDGETS\PRIMITIF\2016\préparation BP 2016 - provisoire\Appui\test\24-grille budgetaire BP 2016.xlsx"

Application.DisplayAlerts = False

'selection des données (copier coller)

Workbooks("24-grille budgetaire BP 2016.xlsx").Sheets("24 (2)").UsedRange.Select

Workbooks("24-grille budgetaire BP 2016.xlsx").Sheets("24 (2)").UsedRange.Copy

Workbooks("récap.xlsm").Activate

DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1

Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select

ActiveSheet.Paste

Application.CutCopyMode = False 'vider le presse papier

Application.DisplayAlerts = False

'fermeture des fichiers

Workbooks("24-grille budgetaire BP 2016.xlsx").Close savechanges:=False

' B) fichier 3

'ouverture des fichiers

Workbooks.Open "M:\CCIE\BUDGETS\PRIMITIF\2016\préparation BP 2016 - provisoire\Appui\test\25-grille budgetaire BP 2016.xlsx"

Application.DisplayAlerts = False

'selection des données (copier coller)

Workbooks("25-grille budgetaire BP 2016.xlsx").Sheets("25 (2)").UsedRange.Select

Workbooks("25-grille budgetaire BP 2016.xlsx").Sheets("25 (2)").UsedRange.Copy

Workbooks("récap.xlsm").Activate

DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1

Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select

ActiveSheet.Paste

Application.CutCopyMode = False 'vider le presse papier

Application.DisplayAlerts = False

'fermeture des fichiers

Workbooks("25-grille budgetaire BP 2016.xlsx").Close savechanges:=False

End sub

Bonjour

Sans fichier pour tester

Sub CreationSynthese()
Dim Chemin As String, Fichier As String, Feuille As String
Dim Ws As Worksheet

  Application.ScreenUpdating = False
  Set Ws = ActiveSheet

  ' effacement de la feuille
  Ws.Cells.Delete

  Chemin = "M:\CCIE\BUDGETS\PRIMITIF\2016\préparation BP 2016 - provisoire\Appui\test\"
  Fichier = Dir(Chemin & "*-grille budgetaire BP 2016.xlsx")

  Do While Fichier <> ""    ' Commence la boucle.
    Feuille = Left(Fichier, 2) & " (2)"
    With Workbooks.Open(Chemin & Fichier)
      .Sheets(Feuille).UsedRange.Copy Ws.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
      .Close savechanges:=False
    End With
    Fichier = Dir           ' Extrait l'entrée suivante.
  Loop

End Sub

Banzai,

Je n'ai qu'une chose à te dire .... Tu dechires tout !!! merci t vraiment un boss,

j'ai tester, c top!!


Rechercher des sujets similaires à "creer boucle importer fichiers"