Bonjour à tous,
Voici mon code :

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Private Sub CommandButton1_Click()
 
On Error Resume Next
 
Dim chemin As String, KRCFile As String
Dim folder As Variant, box As Variant
Dim NBFichier As Integer
Dim wb As Workbook
 
'définit le répertoire contenant les fichiers
chemin = ThisWorkbook.Path & Application.PathSeparator
folder = "KRC_GB-BH\"
 
'tous les fichiers krc*.xlsx du folder
KRCFile = Dir(chemin & folder & "KRC" & "*.xlsx")
 
If KRCFile <> "" Then
'boucle => nombre de fichiers trouvés dans le folder
    While Not KRCFile = ""
        NBFichier = NBFichier + 1
        KRCFile = Dir
    Wend
Else: MsgBox "Not Files in the folder"
Exit Sub
End If
 
box = MsgBox("Find" & " " & NBFichier & " " & "file(s)" & " " & "?", vbYesNo + vbQuestion + vbApplicationModal + vbDefaultButton2, "")
 
KRCFile = Dir(chemin & folder & "KRC" & "*.xlsx")
 
If box = vbYes Then
    If KRCFile <> "" Then
        Application.StatusBar = "Old data erased"
        sh_GlobalKrc.Range("A5:O" & ActiveSheet.UsedRange.Rows.Count - 1).ClearContents
        Application.StatusBar = "Import in progess....."
        Application.ScreenUpdating = False
        Do While KRCFile <> ""
            Application.EnableEvents = False
            'ouvre le fichier trouvé
            Set wb = Workbooks.Open(chemin & folder & KRCFile, ReadOnly:=True)
            wb.Sheets("KRC").Unprotect ("1234")
            If wb.Sheets("KRC").Range("k3") = "Oui / Ja" Then
                wb.Sheets("KRC").Range("A13:N" & wb.Sheets("KRC").UsedRange.Rows.Count).Copy
                sh_GlobalKrc.Range("A1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, operation _
                    :=xlNone, skipblanks:=False, Transpose:=False
                'vide le presse papier
                Call ClearClipboard
            Else
            End If
            'ferme le fichier trouvé en cours
            wb.Close True
            Set wb = Nothing
            KRCFile = Dir
        Loop
        'MsgBox "Import OK"
        Columns("A:O").AutoFit
        Application.Goto reference:=Range("A5")
        Application.ScreenUpdating = True
        Application.StatusBar = False
        Application.EnableEvents = True
    End If
End If
 
End Sub
Mon problème est le suivant : il ouvre bien les fichiers et copie les bonnes cellules CEPENDANT il remplace chaque les fois les données. En résumé, il copie les données du 1er fichier et le ferme, il copie les données du 2e mais en écrasant les données du 1er.
pq??

Merci