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
|
Sub CopyRmas()
Dim Système As Object 'Système de fichiers
Dim Dossier As Object 'Répertoire
Dim Fichiers As Object 'Collection de fichiers du répertoire
Dim Fichier As Object 'Fichier (élément de la collection Fichiers)
Dim Nom_Dossier As String 'Nom du répertoire
Dim Nom_Fichier As String 'Nom du fichier parcouru
Dim Nom_Fichier2 As String 'Nom du fichier jumeau
Dim Def_Fichier2 As String 'Nom du fichier jumeau (emplacement)
Dim compt As Integer 'Compteur de fichiers
'Lecture du répertoire
Nom_Dossier = "C:\Documents and Settings\lehembrej\Mes documents\RMA confidentiel"
Set Système = CreateObject("Scripting.FileSystemObject")
Set Dossier = Système.GetFolder(Nom_Dossier)
Set Fichiers = Dossier.Files
'Contrôler chaque fichier du répertoire
MsgBox Dossier.Files.Count
compt = 0
For Each Fichier In Fichiers
compt = compt + 1
'- On compose le nom du fichier que l'on va aller chercher
Nom_Fichier = Nom_Dossier & "\" & Fichier.Name
' MsgBox Nom_Fichier
'- On ouvre le fichier
Workbooks.Open(Filename:=Nom_Fichier).RunAutoMacros Which:=xlAutoActivate
ActiveWindow.SmallScroll Down:=-51
'- On copie les données qui nous intéressent
Sheets("Recto").Select
Range("A1:BJ93").Select
Selection.Copy
'Création du fichier jumeau
Nom_Fichier2 = "twinfile" & Fichier.Name
Call CreerXLS(Nom_Fichier2)
Def_Fichier2 = Nom_Dossier & "\" & Nom_Fichier2
' MsgBox ("Nom Fichier : " & Nom_Fichier2 & "nb fichiers traités : " & compt)
' Ouverture du fichier jumeau
Workbooks.Open Filename:=Def_Fichier2
' On copie les données dans le fichier jumeau
Sheets("Feuil1").Select
Range("a1").Select
ActiveSheet.Paste
'Sauvegarde et fermeture des deux fichiers
ActiveWorkbook.Save
ActiveWorkbook.Close
ActiveWorkbook.Close
Next Fichier
End Sub |
