Fusionner deux classeurs Excel
Bonjour à tous,
Je dispose de deux dossiers. Chaque dossiers contient le même nombre de fichiers (100) avec des noms identiques :
Dossier 1 : abc.xlsx, fgr.xlx,...
Dossier 2: abc.xlsx, fgr.xlx,...
J'aimerais fusionner les fichiers de même nom. (abc.xlsx avec abc.xlsx).
Code:
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
| Sub SelectFolder()
Set fso = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then ' if OK is pressed
folderpath = .SelectedItems(1)
Set sFolder1DB = fso.GetFolder(folderpath)
End If
End With
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then ' if OK is pressed
folderpath = .SelectedItems(1)
Set sFolder1TB = fso.GetFolder(folderpath)
End If
End With
If sFolder1DB <> "" And sFolder1TB <> "" Then ' if a file was chosen
For Each DBsheet In sFolder1DB.Files
For Each TBsheet In sFolder1TB.Files
Debug.Print DBsheet
Debug.Print TBsheet
If DBsheet.Name = TBsheet.Name Then
Workbooks.Open FileName:=DBsheet.Path
Workbooks(DBsheet).Sheets("Database").Copy _
Before:=Workbooks(TBsheet).Sheets(1)
Workbooks.Close
End If
Next
Next
End If
End Sub |
J'obtiens l'erreur "mismatch 13" sur cette ligne. J'imagine que c'est parce que le classeur de destination n'est pas ouvert. Mais comme les noms sont identiques (abc.xlsx et abc.xlsx), je ne peux pas les ouvrir en même temps.
Code:
1
2
| Workbooks(DBsheet).Sheets("Database").Copy _
Before:=Workbooks(TBsheet).Sheets(1) |
Pouvez-vous svp m'aider à fusionner ces fichiers?
Merci
