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 65 66 67 68 69
| Sub ListeFichiers()
Dim Repertoire As String
Repertoire = Range("Fichiers!B1")
' Contrôle de vailidité du répertoire renseigné dans l'onglet Magnitude
If Len(Repertoire) = 0 Then
MsgBox "l'emplacement du répertoire de sortie n'est pas renseigné. La macro va être arrêtée."
Exit Sub
End If
Sheets("Fichiers").Select
Range("A1").Select
i = 2
nf = Dir(Repertoire & "\*.*") ' premier fichier
Do While nf <> ""
Cells(i, 1) = nf
nf = Dir ' suivant
i = i + 1
Loop
'Touche de raccourci du clavier: Ctrl+m
'
Application.DisplayAlerts = False
Application.Goto Reference:="baseM"
Selection.ClearContents
Range("receptM").Select
'debut de la routine basée sur liste de "Fichiers" départ en B2 j'usqu'au mot FIN
Workbooks.Open Filename:="c:\travail\MENSUEL\CLIENT1.xls"
Application.Goto Reference:="REPORT"
Selection.Copy
Windows("ImportM.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(70, 0).Select
Windows("CLIENT1.xls").Activate
ActiveWindow.Close
Workbooks.Open Filename:="c:\travail\MENSUEL\CLIENT2.xls"
Application.Goto Reference:="REPORT"
Selection.Copy
Windows("ImportM.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(70, 0).Select
Windows("CLIENT2.xls").Activate
ActiveWindow.Close
Workbooks.Open Filename:="c:\travail\MENSUEL\CLIENT3.xls"
Application.Goto Reference:="REPORT"
Selection.Copy
Windows("ImportM.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(70, 0).Select
Windows("CLIENT3.xls").Activate
ActiveWindow.Close
Workbooks.Open Filename:="c:\travail\MENSUEL\nouveau.xls"
Application.Goto Reference:="REPORT"
Selection.Copy
Windows("ImportM.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(70, 0).Select
Windows("nouveau.xls").Activate
ActiveWindow.Close
Sheets("tableau M").Select
Range("A3").Select
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache.Refresh
MsgBox "Le rapport MENSUEL a été intégré, et le tableau croisé mis à jour !"
End Sub |
Partager