Copie des données depuis plusieurs fichiers Excel

Bonjour à tous !

En explorant le forum, j'ai presque réussi à faire ce que je voulais, mais quelques problèmes persistent que je n'arrive pas à les éliminer...

Je voudrais, depuis un dossier source "S" contenant des fichiers xls composés de 3 feuilles, copier tour à tour les données de la plage [A2:P5] de la feuille 3 de chaque fichier, et les empiler sur la feuille 1 d'un autre fichier Excel contenu dans un autre dossier.

Dans cet autre fichier j'ai écris la macro suivante en m'aidant des autres articles de ce forum :

Sub Importer()
Dim principal As ThisWorkbook
Dim repertoire As String, fichier As String
    Application.ScreenUpdating = False
    Set principal = ThisWorkbook
    repertoire = "...\S"
    ChDir repertoire
    fichier = Dir("*.xls")
    Do While fichier <> ""
        If fichier <> principal.Name Then
            Workbooks.Open fichier
            On Error GoTo suivant
            With Sheets("Feuil3")
                On Error GoTo 0
                On Error Resume Next
                .Range(Cells(2, 1), Cells(5, 1)).EntireRow.Copy
                principal.Sheets(1).[a65536].End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
            End With
            ActiveWorkbook.Close False
        End If
suivant:
        If Err.Number = 9 Then MsgBox "Pas de feuille ""Feuil3"" dans le fichier " & fichier
        fichier = Dir
        Loop
End Sub

Mais plusieurs problèmes surviennent :

• Tout fonctionne correctement pour la copie depuis mon premier fichier, mais le deuxième n'est pas copié, et le troisième est copié 2 fois... (je fais le test avec 3 fichiers dans le dossier source)
• Lors de l'exécution de la macro, on m'informe à 2 reprises que le presse-papier contient une grande quantité d'informations, et on me demande si je veux les conserver -> oui / non / annuler ... Le seul moyen de faire "tourner" la macro sans que tout ne se ferme, étant de cliquer sur "annuler" 2 fois. C'est comme ça que j'obtient le résultat décris ci-dessus...
• Le premier et le dernier des trois fichiers à copier restent ouverts à la fin.

D'une certaine manière j'ai le sentiment que toutes ces erreurs sont liées, mais après plusieurs heures à plancher dessus, je ne trouve aucune solution, je m'en remet donc à vous...

Merci d'avance !

Bonne journée

Bon jour Guillaume, bonjour le forum,

Je pense que c'est ta gestion des erreurs qui pose problème... Essaie comme ça :

Sub Importer()
Dim P As Workbook
Dim OP As Worksheet
Dim R As String, F As String
Dim S As Workbook
Dim OS As Worksheet
Dim DEST As Range

Application.ScreenUpdating = False
Set P = ThisWorkbook
Set OP = P.Sheets(1)
R = P.Path & "\"
F = Dir(R & "*.xls")
Do While F <> ""
    If Not F = P.Name Then
        Workbooks.Open R & F
        Set S = ActiveWorkbook
        On Error Resume Next
        Set OS = S.Sheets(3)
        If Err <> 0 Then GoTo suivant
        Set DEST = OP.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)
        OS.Range(Cells(2, 1), Cells(5, 1)).EntireRow.Copy
        DEST.PasteSpecial (xlPasteValues)
        S.Close False
    End If
suivant:
    If Err.Number = 9 Then MsgBox "Pas de feuille ""Feuil3"" dans le fichier " & F
    F = Dir
Loop
Application.ScreenUpdating = True
End Sub

Merci pour ta réponse ThauThème !

Malheureusement, ton code génère exactement les même erreurs que j'ai décris dans mon premier post, à un petit détail près...

Le message concernant le presse-papier s'affiche toujours à deux reprises, mais cette fois, si je clique sur oui ou non, les fichiers ne sont plus ouverts à la fin de ma macro, donc c'est déjà un bon point, en revanche, on a toujours uniquement le premier et le 3ème fichier qui ont été copiés, mais ce dernier n'a pas été copié 2 fois... (1/2 bon point ?)

Pour plus de détail sur ce qui ce passe :

Si je clique à deux reprises sur "annuler" dans le message du presse-papier, en fin de macro, les fichiers "copiés" restent ouvert sur la feuille 3 et la plage de cellules à copier est sélectionnée (cadre pointillés) (seulement le premier et le 3ème, le deuxième fichier est fermé) -> Est-ce que ça ne serait pas ça qui poserait problème avec le presse papier et la fermeture du fichier ???

Si je clique la première fois sur "oui" ou "non" et la deuxième fois sur "annuler" -> je n'ai plus qu'un fichier ouvert à la fin (le dernier) et si je commence par appuyer sur "annuler" puis "oui" -> c'est le premier fichier qui est ouvert...

Voilà, une idée ?

-----------------------------------------------------------EDIT---------------------------------------------------------

Je crois que j'ai bien avancé ce matin en rajoutant simplement un "Application.CutCopyMode = False" Juste avant de fermer mon fichier S, dans le code de ThauThème :

DEST.PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
S.Close False

Plus de messages presse-papier, plus de fichiers ouverts à la fin de la macro, de tout mes problème il n'en subsiste qu'un : sur les trois plages de valeurs qui devraient être copiés seuls celles issues du premier fichier et du dernier sont copiés...

Est-ce que ça ne ressemblerait pas à un Offset défectueux qui ne marche qu'au premier coup ? (les données copiées après le premier fichier venant écraser tour à tour les précédentes pour qu'il ne reste plus que les dernières...)

Bonjour le Forum,

Désolé d'avoir mis si longtemps a venir clôturer ce sujet, mon projet passait par d'autres priorités.

Entre-temps, j'ai trouvé de l'aide auprès d'un collègue, qui m'a conseillé de nommer ma plage de cellule, ça plus deux trois modifs structurelles dans mon code m'a permis de le faire fonctionner à souhait :

Sub Importer()
Dim P As Workbook
Dim OP As Worksheet
Dim R As String, F As String
Dim S As Workbook
Dim DEST As Range

Application.ScreenUpdating = False
Set P = ThisWorkbook
Set OP = P.Sheets(1)
R = "\Mon dossier\"
F = Dir(R & "*.xls")

Sheets("Bilan").Select
Cells.Select
Selection.ClearContents

Do While F <> "Modèle.xlsm"
    If Not F = P.Name Then
        Workbooks.Open R & F
        Set S = ActiveWorkbook
        On Error Resume Next
        Set DEST = OP.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)
        Sheets("lalala").Select
        Range("Source").Copy
        DEST.PasteSpecial (xlPasteValues)
        Application.CutCopyMode = False
    End If
suivant:
    If Err.Number = 9 Then MsgBox "Pas de feuille ""lalala"" dans le fichier " & F
    F = Dir
Loop

End Sub

"Source" étant ici le nom donné à la plage de valeurs à copier dans mes fichiers sources.

pour nommer une plage de valeur : la sélectionner, puis dans le petit champs de saisie en haut à gauche de la feuille, saisir le nom voulu et appuyer dur "Entrer".

Voilà merci à ceux qui m'ont permis d'avancer !

A bientôt sur le forum...