Bonjour à tous,

Je débute en VBA et aurais besoin d'un peu d'aide pour finaliser/corriger un bout de code qui ne marche pas très bien.

Voilà mon problème:
J'ai plusieurs dizaines de fichiers excel à traiter chaque semaine en compilant manuellement les différentes données de chaque fichier dans une feuille unique.
Tous les fichiers sont dans un même répertoire unique et ont exactement la même structure.
Pour être précis, aujourd'hui, j'ouvre manuellement chaque fichier et copie toutes les données de l'onglet "Exp" des colonnes B, P, Q, AB, AC à partir de la ligne 2 que je viens coller dans un autre fichier. L'opération est répété pour tous les fichiers contenu dans le répertoire, toutes les données sont collées à la suite des autres dans les colonnes A à E.

En naviguant un peu sur le site, j'ai pu arriver à un bout de code qui fait le travail mais uniquement en mode run pas à pas. Lorsque je lance la macro en auto, une grande partie des données est perdu.. j'ai l'impression que le PC n'arrive pas à traiter toutes les informations en mode copié/collé..

Est-ce que quelqu'un aurait une solution à mon problème?
Merci d'avance

J'ai copié la macro ci-dessous:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub Importe()
Dim dossier As Object, Fichier As Object, Chemin As String, Lg As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Range("A2:E65536").ClearContents
Chemin = ThisWorkbook.Path
           FName = Dir(Chemin & "\" & "*.xls")
Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Fichier In dossier.Files
 
NomFichier = Fichier.Name
If Not Fichier.Name = "IMPORT.xlsm" Then
Lg = Range("A65536").End(xlUp).Row + 1
Workbooks.Open Filename:=Chemin & "/" & NomFichier
On Error Resume Next
 
With Workbooks(NomFichier)
    .Sheets("recup pidi").Range("C2:C" & Range("A65536").End(xlUp).Row).Copy
    ThisWorkbook.Sheets("Feuil1").Range("A" & Lg).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .Sheets("recup pidi").Range("P2:Q" & Range("A65536").End(xlUp).Row).Copy
    ThisWorkbook.Sheets("Feuil1").Range("B" & Lg).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .Sheets("recup pidi").Range("AB2:AC" & Range("A65536").End(xlUp).Row).Copy
    ThisWorkbook.Sheets("Feuil1").Range("D" & Lg).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
.Close
End With
End If
Next
Application.DisplayAlerts = True
End Sub