synthétiser macro par routine jusqu'au mot "FIN"

Version imprimable

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
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

Bonjour,

voici la feuille "Fichiers" dans laquelle je reçois un DIR du répertoire choisi
à coté en B2 je retrace le chemin complet pour chaque fichier
donc, je voudrais changer la macro actuelle par un appel à chaque fichier
départ en B2 et fin au mot fin qui est actuellement en B31.

03/01/2015, 11h24
Daniel.C

Bonjour,

Est-ce que tu peux donner un exemple ? Pour le second fichier, par exemple ?
03/01/2015, 11h47
fuler

dans chaque fichier "client" du répertoire, il y a la plage nommée "REPORT"
je veux les récupérer pour coller les valeurs dans la feuille nommée "importM"
le premier "client" (chemin d'accès = B2 de feuille "Fichiers")
est collé sur la référence "receptM" de la feuille importM (qui va recevoir toutes les données)
puis, je décale de 70 lignes, ferme le fichier client en cours pour passer au
client suivant (chemin d'accès = B3 de feuille "Fichiers")
ainsi de suite jusqu'au mot "FIN" qui se trouve au bas des chemins d'accès, pour l'instant = B31
cette même feuille "Fichiers"
03/01/2015, 12h02
Daniel.C

Citation:

la référence "receptM" de la feuille importM

C'est quoi, "la référence" ? Une plage nommée ?

Citation:

il y a la plage nommée "REPORT"

Est-ce que toutes les plages ont la même taille ?
03/01/2015, 12h24
fuler

-1- la référence "receptM" est en fait la cible de départ des réceptions de données

-2- les plages n'auront pas forcément la même taille
en colne OUI = A : F
en ligne NON = c'est pour cela que je décale de 70 lignes, sachant que 60 lignes
devraient suffire, je prévoit plus large.

Non testé :

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
Public Ligne As Long, Col As Integer
Sub ListeFichiersDaniel()
    Dim Repertoire As String
        Repertoire = Range("Fichiers!B1")
    With ThisWorkbook.Sheets("importM")
        Col = .Range("receptM").Column
        Ligne = .Range("receptM").Row
    End With
    ' 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
        Traitement Repertoire & "\" & nf
        nf = Dir ' suivant
        i = i + 1
     Loop
 End Sub
Sub Traitement(Fichier)
    With ThisWorkbook.Sheets("importM")
        Workbooks.Open Fichier
        ActiveWorkbook.Sheets("importM").Range("REPORT").Copy
        .Cells(Ligne + 1, Col).PasteSpecial xlPasteValues
        ActiveWorkbook.Close False
        Ligne = Ligne + 70
    End With
End Sub

à mettre en t^te d'un module.

13/01/2015, 10h32
fuler

pour un premier essai, j'ai été refroidi par le Webmestre, car je n'ai pas suivi vos habitudes,
j'ignorais vos pratiques en matières de code !!!
Par contre je remercie chaleureusement DANIEL.C
pour son travail qui m'a été très utile par sa clarté et sa légèreté par rapport au code de
départ.
J'ai retravaillé selon mes fichiers spécifiques, mais la procédure me convient parfaitement.
Donc merci à tous, je serai plus méthodique par la suite.