pb de transfert de certaines données de tous les fichiers d'un dossier vers un autre ?

Le
Antoine76
Bonjour à tous,

Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page, une
liste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :

A B C D E
F G
1 ( ligne vide pour touche d'activation de macros
)
2 Noms Début Fin Statut I.J. Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84 141
477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42


L'objectif de la macro de ce nouveau fichier, serait de transférer, pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de la 3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C présente
la mention "En cours", et, si possible, de faire précéder ce transfert de la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère feuille
du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la macro,
ainsi que la composition de chaque fichier. Si nécessaire, je peux joindre
le fichier en cjoint

Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?

Merci de vos conseils

Antoine
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Youky
Le #3458631
Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky

Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub

"Antoine76"
Bonjour à tous,

Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page, une
liste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :

A B C D E
F G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J. Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84 141
477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...

L'objectif de la macro de ce nouveau fichier, serait de transférer, pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C présente
la mention "En cours", et, si possible, de faire précéder ce transfert de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère feuille
du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la macro,
ainsi que la composition de chaque fichier. Si nécessaire, je peux joindre
le fichier en cjoint...

Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?

Merci de vos conseils

Antoine






Antoine76
Le #3361791
Bonsoir Youki,

Merci pour ta réponse. J'étais de sortie samedi soir, et je viens seulement
de tester ton programme. Il fonctionne bien, à un petit détail près : je ne
t'ai pas précisé que la 1ère page de tous les fichiers source sollicités est
déjà le fruit d'une réactualisation en Auto_Open (à partir de l'ensemble des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le message :
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."

J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!

Est-ce qu'il y a une solution pour le faire fonctionner en gardant cette
Auto_Open (identique à tous les fichiers) ?

Petite question annexe, dans le code que tu as écris, je ne comprends pas
plusieurs petites chose que tu as écrites et qui fonctionnent très bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une variable et
que je n'ai pas trouvé comme fonction ?

Dans tous les cas, Grand Merci pour ta contribution !

Antoine



"Youky" 43c033a0$0$19695$
Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky

Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub

"Antoine76"
Bonjour à tous,

Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page,
une


liste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :

A B C D
E


F G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J. Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141


477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...

L'objectif de la macro de ce nouveau fichier, serait de transférer, pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présente


la mention "En cours", et, si possible, de faire précéder ce transfert
de


la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuille


du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,


ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindre


le fichier en cjoint...

Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?

Merci de vos conseils

Antoine










Youky
Le #3361621
Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forum
la manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions

le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"
le rôle du $
pas sur de moi mais en principe cela fait que la variable est considérée

comme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky

"Antoine76"
Bonsoir Youki,

Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près : je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le message
:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."

J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!

Est-ce qu'il y a une solution pour le faire fonctionner en gardant cette
Auto_Open (identique à tous les fichiers) ?

Petite question annexe, dans le code que tu as écris, je ne comprends pas
plusieurs petites chose que tu as écrites et qui fonctionnent très bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une variable et
que je n'ai pas trouvé comme fonction ?

Dans tous les cas, Grand Merci pour ta contribution !

Antoine



"Youky" 43c033a0$0$19695$
Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky

Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub

"Antoine76"
Bonjour à tous,

Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page,
une


liste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :

A B C D
E


F G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141


477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...

L'objectif de la macro de ce nouveau fichier, serait de transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présente


la mention "En cours", et, si possible, de faire précéder ce transfert
de


la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuille


du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,


ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindre


le fichier en cjoint...

Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?

Merci de vos conseils

Antoine














Antoine76
Le #3361441
Rebonsoir Youki

En Auto_Open, j'ai une "mise à jour" de "l'état d'avancement de dossier"
correspondant à chaque feuille (transfert du lien H pour un accès rapide, et
recopie des cellules contenant différentes valeur caractéristiques de
l'évolution de chaque dossier) ; Pour plus d'Info , j'ai déposé les lignes
de code (réalisé pour une bonne part grace à MFPE) à la fin de ce message.
Sur ta proposition, j'ai transféré l'ensemble de ces lignes de programme sur
Workbook_Open, ce qui me donne exactement le même résultat (no comment !).
Ton idée était donc plus que recevable!
Quant à la macro que tu m'as écrite, elle fonctionne dans ce cas
IMPECCABLEMENT (no comment bis !).

A propos de ta macro, il est toujours très intéressant de voir comment
"d'autre(s)" font une macro que l'on ne sait pas soi-même appréhender ;
c'est peut-être là que l'on apprend le plus !...

Merci à toi

Antoine

' désactive le rafraîchissement de l'écran
Application.ScreenUpdating = False
' déclaration des variables du classement alphabétique
Dim a(256), j As Integer, k As Integer, n As Integer, temp
' comptage du nombre de feuilles
n = Sheets.Count
For j = 1 To n
a(j) = Sheets(j).Name
Next j
' tri des feuilles
For j = 1 To n
For k = j To n
If a(k) < a(j) Then
temp = a(k)
a(k) = a(j)
a(j) = temp
End If
Next k
Next j
' positionnement des feuilles selon la lettre
For j = 1 To n
Sheets(a(j)).Move before:=Sheets(j)
Next j
' déclaration des variables de la feuille sommaire
Dim wsh As Worksheet, i As Integer, H As Hyperlink, x As String, R
As Range
' met la feuille Arrêt de travail type en Nième position des feuilles
Sheets("Arrêt de travail type").Move After:=Sheets(Sheets.Count)
' met la feuille Sommaire en 1ère position des feuilles
Sheets("Sommaire").Move before:=Sheets(1)
' efface toutes les celules de la feuille Sommaire
Range("A:H").Select
Selection.ClearContents
' sélectionne la cellule B1 de la feuille "Sommaire"
Sheets("Sommaire").Select
' cycle de création des transfert de valeurs
Range("B1").Select
For Each wsh In ActiveWorkbook.Sheets
i = i + 1
' créé en colonne B un lien hypertexte pour toutes les feuilles du
classeur
ActiveSheet.Hyperlinks.Add Anchor:Îlls(i + 1, 1), Address:="", _
SubAddress:="'" & wsh.Name & "'" & "!A1", TextToDisplay:=wsh.Name
' transfert de la date/début (B9 de chaque feuille) sur la feuille
"Sommaire"
Cells(i + 1, 2) = wsh.Range("B9")
' transfert l'état "En cours/Soldé" (D4 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 3) = wsh.Range("D4")
' la remplace par la date de dernière I.J. de compagnie de chaque
feuille sur la feuille "Sommaire"
If Not LCase(Cells(i + 1, 3)) Like "en cours" Then Cells(i + 1, 3) _
Application.WorksheetFunction.Max(wsh.Range("J9:J200"))
' transfert l'état "Cadre/Non Cadre" (C3 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 4) = wsh.Range("C3")
' transfert de la dernière I.J. Compagnie versée sur la feuille
"Sommaire"
Cells(i + 1, 5) = wsh.Range("N25")
' transfert du nombre de jours Compagnie (somme de P11 à P200) sur la
feuille "Sommaire"
Cells(i + 1, 6) Application.WorksheetFunction.Sum(wsh.Range("P11:P200"))
' transfert des I.J. totales versées /Compagnie (somme de K8 à K200)
sur la feuille "Sommaire"
Cells(i + 1, 7) Application.WorksheetFunction.Sum(wsh.Range("K9:K200"))
Next
' suprime le lien hyperT et les 3 cellules de droite de la 2ème ligne
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Sommaire") Then
Set R = Range(H.Parent.Address)
R = "Salariés en arrêt"
Set R = R.Offset(0, 1)
R = "Début d' arrêt"
Set R = R.Offset(0, 1)
R = "Fin d' arrêt"
Set R = R.Offset(0, 1)
R = "Statut"
Set R = R.Offset(0, 1)
R = "I.J. Cie / jour"
Set R = R.Offset(0, 1)
R = "Nb. de jours"
Set R = R.Offset(0, 1)
R = "I.J. Cie cumulées"
H.Delete
End If
Next
' met en couleur les 7 cellules de titres
Range("A2:G2").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.ColorIndex = 9
End With
' supprime les 6 cellules de droite du lien hyperT de Arrêt de travail
type
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Arrêt de travail type") Then
Set R = Range(H.Parent.Address)
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
End If
Next
' applique à A2 le format de cellule de B2
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
' réactive le rafraîchissement de l'écran
Application.ScreenUpdating = True
Range("A1").Select
End Sub




"Youky" 43c15d47$0$6661$
Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forum
la manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions

le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"
le rôle du $
pas sur de moi mais en principe cela fait que la variable est considérée

comme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky

"Antoine76"
Bonsoir Youki,

Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près : je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message


:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."

J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!

Est-ce qu'il y a une solution pour le faire fonctionner en gardant cette
Auto_Open (identique à tous les fichiers) ?

Petite question annexe, dans le code que tu as écris, je ne comprends
pas


plusieurs petites chose que tu as écrites et qui fonctionnent très bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une variable
et


que je n'ai pas trouvé comme fonction ?

Dans tous les cas, Grand Merci pour ta contribution !

Antoine



"Youky" 43c033a0$0$19695$
Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky

Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub

"Antoine76"
Bonjour à tous,

Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page,
une


liste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :

A B C D
E


F G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141


477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...

L'objectif de la macro de ce nouveau fichier, serait de transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de
la




3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présente


la mention "En cours", et, si possible, de faire précéder ce
transfert




de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuille


du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,


ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindre


le fichier en cjoint...

Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?

Merci de vos conseils

Antoine


















Youky
Le #3359941
Trés belle macro, superbe, et quand tout fonctionne la magie fait son
oeuvre.
Cela m'a fait plaisir d'avoir réussit ta demande.
Youky
A+
"Antoine76"
Rebonsoir Youki

En Auto_Open, j'ai une "mise à jour" de "l'état d'avancement de dossier"
correspondant à chaque feuille (transfert du lien H pour un accès rapide,
et
recopie des cellules contenant différentes valeur caractéristiques de
l'évolution de chaque dossier) ; Pour plus d'Info , j'ai déposé les lignes
de code (réalisé pour une bonne part grace à MFPE) à la fin de ce message.
Sur ta proposition, j'ai transféré l'ensemble de ces lignes de programme
sur
Workbook_Open, ce qui me donne exactement le même résultat (no comment !).
Ton idée était donc plus que recevable!
Quant à la macro que tu m'as écrite, elle fonctionne dans ce cas
IMPECCABLEMENT (no comment bis !).

A propos de ta macro, il est toujours très intéressant de voir comment
"d'autre(s)" font une macro que l'on ne sait pas soi-même appréhender ;
c'est peut-être là que l'on apprend le plus !...

Merci à toi

Antoine

' désactive le rafraîchissement de l'écran
Application.ScreenUpdating = False
' déclaration des variables du classement alphabétique
Dim a(256), j As Integer, k As Integer, n As Integer, temp
' comptage du nombre de feuilles
n = Sheets.Count
For j = 1 To n
a(j) = Sheets(j).Name
Next j
' tri des feuilles
For j = 1 To n
For k = j To n
If a(k) < a(j) Then
temp = a(k)
a(k) = a(j)
a(j) = temp
End If
Next k
Next j
' positionnement des feuilles selon la lettre
For j = 1 To n
Sheets(a(j)).Move before:=Sheets(j)
Next j
' déclaration des variables de la feuille sommaire
Dim wsh As Worksheet, i As Integer, H As Hyperlink, x As String, R
As Range
' met la feuille Arrêt de travail type en Nième position des feuilles
Sheets("Arrêt de travail type").Move After:=Sheets(Sheets.Count)
' met la feuille Sommaire en 1ère position des feuilles
Sheets("Sommaire").Move before:=Sheets(1)
' efface toutes les celules de la feuille Sommaire
Range("A:H").Select
Selection.ClearContents
' sélectionne la cellule B1 de la feuille "Sommaire"
Sheets("Sommaire").Select
' cycle de création des transfert de valeurs
Range("B1").Select
For Each wsh In ActiveWorkbook.Sheets
i = i + 1
' créé en colonne B un lien hypertexte pour toutes les feuilles du
classeur
ActiveSheet.Hyperlinks.Add Anchor:Îlls(i + 1, 1), Address:="", _
SubAddress:="'" & wsh.Name & "'" & "!A1", TextToDisplay:=wsh.Name
' transfert de la date/début (B9 de chaque feuille) sur la feuille
"Sommaire"
Cells(i + 1, 2) = wsh.Range("B9")
' transfert l'état "En cours/Soldé" (D4 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 3) = wsh.Range("D4")
' la remplace par la date de dernière I.J. de compagnie de chaque
feuille sur la feuille "Sommaire"
If Not LCase(Cells(i + 1, 3)) Like "en cours" Then Cells(i + 1, 3)
_
Application.WorksheetFunction.Max(wsh.Range("J9:J200"))

' transfert l'état "Cadre/Non Cadre" (C3 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 4) = wsh.Range("C3")
' transfert de la dernière I.J. Compagnie versée sur la feuille
"Sommaire"
Cells(i + 1, 5) = wsh.Range("N25")
' transfert du nombre de jours Compagnie (somme de P11 à P200) sur la
feuille "Sommaire"
Cells(i + 1, 6) > Application.WorksheetFunction.Sum(wsh.Range("P11:P200"))
' transfert des I.J. totales versées /Compagnie (somme de K8 à K200)
sur la feuille "Sommaire"
Cells(i + 1, 7) > Application.WorksheetFunction.Sum(wsh.Range("K9:K200"))
Next
' suprime le lien hyperT et les 3 cellules de droite de la 2ème ligne
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Sommaire") Then
Set R = Range(H.Parent.Address)
R = "Salariés en arrêt"
Set R = R.Offset(0, 1)
R = "Début d' arrêt"
Set R = R.Offset(0, 1)
R = "Fin d' arrêt"
Set R = R.Offset(0, 1)
R = "Statut"
Set R = R.Offset(0, 1)
R = "I.J. Cie / jour"
Set R = R.Offset(0, 1)
R = "Nb. de jours"
Set R = R.Offset(0, 1)
R = "I.J. Cie cumulées"
H.Delete
End If
Next
' met en couleur les 7 cellules de titres
Range("A2:G2").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.ColorIndex = 9
End With
' supprime les 6 cellules de droite du lien hyperT de Arrêt de travail
type
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Arrêt de travail type") Then
Set R = Range(H.Parent.Address)
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
End If
Next
' applique à A2 le format de cellule de B2
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
' réactive le rafraîchissement de l'écran
Application.ScreenUpdating = True
Range("A1").Select
End Sub




"Youky" 43c15d47$0$6661$
Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forum
la manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions

le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"
le rôle du $
pas sur de moi mais en principe cela fait que la variable est considérée

comme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky

"Antoine76"
Bonsoir Youki,

Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près :
je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source
sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de
l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message


:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."

J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!

Est-ce qu'il y a une solution pour le faire fonctionner en gardant
cette
Auto_Open (identique à tous les fichiers) ?

Petite question annexe, dans le code que tu as écris, je ne comprends
pas


plusieurs petites chose que tu as écrites et qui fonctionnent très
bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une variable
et


que je n'ai pas trouvé comme fonction ?

Dans tous les cas, Grand Merci pour ta contribution !

Antoine



"Youky" 43c033a0$0$19695$
Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres
un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky

Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub

"Antoine76"
Bonjour à tous,

Je voudrais créer une macro, dans un fichier Excel vierge, qui
ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première
page,
une


liste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après
:

A B C D
E


F G
1 ( ligne vide pour touche d'activation
de
macros
...)
2 Noms Début Fin Statut I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141


477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...

L'objectif de la macro de ce nouveau fichier, serait de transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de
la




3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présente


la mention "En cours", et, si possible, de faire précéder ce
transfert




de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuille


du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,


ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindre


le fichier en cjoint...

Je ne sais pas comment faire pour créer une telle macro, et si il
est
possible de le faire sans ouvrir à chaque fois le fichier ?

Merci de vos conseils

Antoine






















Antoine76
Le #3356991
bonsoir Youky !

Je ne sais plus trop que dire !
Ainsi que je te l'ai évoqué, le programme que j'ai fait avec la
collaboration (majoritaire!) de JB fonctionne OK;
Celui que tu m'a fait aussi (notamment après l'adoption dans Workbook _Open)
!

Le problème ?
C'est que quand je vais au fond de l'intégration des macros dans les
fichiers, la corde casse !
Et je ne comprends plus rien ! Est-ce dû à la déclaration des variables, au
nom des fichiers qui ont un trait d'union("Arrêt de travail - jean-louis
DAVID"), à.... ? J'ai essayé de tout triturer dans tous les sens, rien n'y
fait ! Je suis en panne d'idée :-((((
La mort dans l'âme, je me résigne à livrer de manière brute, en 1er le
fichier satellite, avec macro (qui doit être multiple...), en 2ème le
fichier de centralisation de l'évolution des données :
N° 1 : http://cjoint.com/?bjwdXuxpKW

N° 2 : http://cjoint.com/?bjwf56LCvu

Je ne sais plus quoi ajouter, si ce n'est un certain désarroi, qui n'exclut
pas pour autant la volonté de comprendre pourquoi, comment !

Antoine

"Youky" 43c22a42$0$29210$
Trés belle macro, superbe, et quand tout fonctionne la magie fait son
oeuvre.
Cela m'a fait plaisir d'avoir réussit ta demande.
Youky
A+
"Antoine76"
Rebonsoir Youki

En Auto_Open, j'ai une "mise à jour" de "l'état d'avancement de dossier"
correspondant à chaque feuille (transfert du lien H pour un accès
rapide,


et
recopie des cellules contenant différentes valeur caractéristiques de
l'évolution de chaque dossier) ; Pour plus d'Info , j'ai déposé les
lignes


de code (réalisé pour une bonne part grace à MFPE) à la fin de ce
message.


Sur ta proposition, j'ai transféré l'ensemble de ces lignes de programme
sur
Workbook_Open, ce qui me donne exactement le même résultat (no comment
!).


Ton idée était donc plus que recevable!
Quant à la macro que tu m'as écrite, elle fonctionne dans ce cas
IMPECCABLEMENT (no comment bis !).

A propos de ta macro, il est toujours très intéressant de voir comment
"d'autre(s)" font une macro que l'on ne sait pas soi-même appréhender ;
c'est peut-être là que l'on apprend le plus !...

Merci à toi

Antoine

' désactive le rafraîchissement de l'écran
Application.ScreenUpdating = False
' déclaration des variables du classement alphabétique
Dim a(256), j As Integer, k As Integer, n As Integer, temp
' comptage du nombre de feuilles
n = Sheets.Count
For j = 1 To n
a(j) = Sheets(j).Name
Next j
' tri des feuilles
For j = 1 To n
For k = j To n
If a(k) < a(j) Then
temp = a(k)
a(k) = a(j)
a(j) = temp
End If
Next k
Next j
' positionnement des feuilles selon la lettre
For j = 1 To n
Sheets(a(j)).Move before:=Sheets(j)
Next j
' déclaration des variables de la feuille sommaire
Dim wsh As Worksheet, i As Integer, H As Hyperlink, x As String,
R


As Range
' met la feuille Arrêt de travail type en Nième position des feuilles
Sheets("Arrêt de travail type").Move After:=Sheets(Sheets.Count)
' met la feuille Sommaire en 1ère position des feuilles
Sheets("Sommaire").Move before:=Sheets(1)
' efface toutes les celules de la feuille Sommaire
Range("A:H").Select
Selection.ClearContents
' sélectionne la cellule B1 de la feuille "Sommaire"
Sheets("Sommaire").Select
' cycle de création des transfert de valeurs
Range("B1").Select
For Each wsh In ActiveWorkbook.Sheets
i = i + 1
' créé en colonne B un lien hypertexte pour toutes les feuilles du
classeur
ActiveSheet.Hyperlinks.Add Anchor:Îlls(i + 1, 1), Address:="",
_


SubAddress:="'" & wsh.Name & "'" & "!A1", TextToDisplay:=wsh.Name
' transfert de la date/début (B9 de chaque feuille) sur la feuille
"Sommaire"
Cells(i + 1, 2) = wsh.Range("B9")
' transfert l'état "En cours/Soldé" (D4 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 3) = wsh.Range("D4")
' la remplace par la date de dernière I.J. de compagnie de chaque
feuille sur la feuille "Sommaire"
If Not LCase(Cells(i + 1, 3)) Like "en cours" Then Cells(i + 1,
3)


_
Application.WorksheetFunction.Max(wsh.Range("J9:J200"))


' transfert l'état "Cadre/Non Cadre" (C3 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 4) = wsh.Range("C3")
' transfert de la dernière I.J. Compagnie versée sur la feuille
"Sommaire"
Cells(i + 1, 5) = wsh.Range("N25")
' transfert du nombre de jours Compagnie (somme de P11 à P200) sur la
feuille "Sommaire"
Cells(i + 1, 6) > > Application.WorksheetFunction.Sum(wsh.Range("P11:P200"))
' transfert des I.J. totales versées /Compagnie (somme de K8 à K200)
sur la feuille "Sommaire"
Cells(i + 1, 7) > > Application.WorksheetFunction.Sum(wsh.Range("K9:K200"))
Next
' suprime le lien hyperT et les 3 cellules de droite de la 2ème ligne
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Sommaire") Then
Set R = Range(H.Parent.Address)
R = "Salariés en arrêt"
Set R = R.Offset(0, 1)
R = "Début d' arrêt"
Set R = R.Offset(0, 1)
R = "Fin d' arrêt"
Set R = R.Offset(0, 1)
R = "Statut"
Set R = R.Offset(0, 1)
R = "I.J. Cie / jour"
Set R = R.Offset(0, 1)
R = "Nb. de jours"
Set R = R.Offset(0, 1)
R = "I.J. Cie cumulées"
H.Delete
End If
Next
' met en couleur les 7 cellules de titres
Range("A2:G2").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.ColorIndex = 9
End With
' supprime les 6 cellules de droite du lien hyperT de Arrêt de travail
type
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Arrêt de travail type") Then
Set R = Range(H.Parent.Address)
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
End If
Next
' applique à A2 le format de cellule de B2
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
' réactive le rafraîchissement de l'écran
Application.ScreenUpdating = True
Range("A1").Select
End Sub




"Youky" 43c15d47$0$6661$
Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forum
la manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions

le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"
le rôle du $
pas sur de moi mais en principe cela fait que la variable est

considérée



comme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky

"Antoine76"
Bonsoir Youki,

Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près :
je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source
sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de
l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message


:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."

J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!

Est-ce qu'il y a une solution pour le faire fonctionner en gardant
cette
Auto_Open (identique à tous les fichiers) ?

Petite question annexe, dans le code que tu as écris, je ne comprends
pas


plusieurs petites chose que tu as écrites et qui fonctionnent très
bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une
variable




et
que je n'ai pas trouvé comme fonction ?

Dans tous les cas, Grand Merci pour ta contribution !

Antoine



"Youky" 43c033a0$0$19695$
Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres
un
module
et y mets cette macro et enregistre ton fichier dans le bon
répertoire





(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky

Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub

"Antoine76"
Bonjour à tous,

Je voudrais créer une macro, dans un fichier Excel vierge, qui
ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un
dossier






"Clients".
Chaque fichier de ce dossier contient, toujours sur la première
page,
une


liste qui commence à partir de la ligne 3 jusqu'à n, comme
ci-après






:

A B C D
E


F G
1 ( ligne vide pour touche d'activation
de
macros
...)
2 Noms Début Fin Statut
I.J.






Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141


477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...

L'objectif de la macro de ce nouveau fichier, serait de
transférer,






pour
chaque fichier du dossier "Clients", toutes les lignes (à partir
de






la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présente


la mention "En cours", et, si possible, de faire précéder ce
transfert




de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuille


du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de
la






macro,
ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindre


le fichier en cjoint...

Je ne sais pas comment faire pour créer une telle macro, et si il
est
possible de le faire sans ouvrir à chaque fois le fichier ?

Merci de vos conseils

Antoine


























Youky
Le #3457811
Faut pas désepérer, y a toujours une solution, surtout si on enlève les
betises.
Cette fois avec l'aide de tes fichiers j'ai testé , ca marche, j'ai fait des
modifs
dans cette macro rajout du "chem" avec Open que j'avais oublié.
J'ai mis ="En cours" au lieu <>"En cours" tout dépend lequels tu veux.
Youky

Sub Récapitulatif()
Cells.ClearContents
Dim a(200, 20)
Dim F, chem As String
Dim b, k, lig, n, nl As Long
chem = ActiveWorkbook.Path & ""
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Récapitulatif inter-entreprises des Arrêts de travail.xls" Then GoTo
saute
'F = "Formulaires Arrêt de travail.xls" Then GoTo saute
Workbooks.Open chem & F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [J1]
For b = 1 To 10
a(n, b + 1) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close savechanges:úlse
For nl = 1 To n
lig = lig + 1
For k = 1 To 8
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub

"Antoine76" %
bonsoir Youky !

Je ne sais plus trop que dire !
Ainsi que je te l'ai évoqué, le programme que j'ai fait avec la
collaboration (majoritaire!) de JB fonctionne OK;
Celui que tu m'a fait aussi (notamment après l'adoption dans Workbook
_Open)
!

Le problème ?
C'est que quand je vais au fond de l'intégration des macros dans les
fichiers, la corde casse !
Et je ne comprends plus rien ! Est-ce dû à la déclaration des variables,
au
nom des fichiers qui ont un trait d'union("Arrêt de travail - jean-louis
DAVID"), à.... ? J'ai essayé de tout triturer dans tous les sens, rien n'y
fait ! Je suis en panne d'idée :-((((
La mort dans l'âme, je me résigne à livrer de manière brute, en 1er le
fichier satellite, avec macro (qui doit être multiple...), en 2ème le
fichier de centralisation de l'évolution des données :
N° 1 : http://cjoint.com/?bjwdXuxpKW

N° 2 : http://cjoint.com/?bjwf56LCvu

Je ne sais plus quoi ajouter, si ce n'est un certain désarroi, qui
n'exclut
pas pour autant la volonté de comprendre pourquoi, comment !

Antoine

"Youky" 43c22a42$0$29210$
Trés belle macro, superbe, et quand tout fonctionne la magie fait son
oeuvre.
Cela m'a fait plaisir d'avoir réussit ta demande.
Youky
A+
"Antoine76"
Rebonsoir Youki

En Auto_Open, j'ai une "mise à jour" de "l'état d'avancement de
dossier"
correspondant à chaque feuille (transfert du lien H pour un accès
rapide,


et
recopie des cellules contenant différentes valeur caractéristiques de
l'évolution de chaque dossier) ; Pour plus d'Info , j'ai déposé les
lignes


de code (réalisé pour une bonne part grace à MFPE) à la fin de ce
message.


Sur ta proposition, j'ai transféré l'ensemble de ces lignes de
programme
sur
Workbook_Open, ce qui me donne exactement le même résultat (no comment
!).


Ton idée était donc plus que recevable!
Quant à la macro que tu m'as écrite, elle fonctionne dans ce cas
IMPECCABLEMENT (no comment bis !).

A propos de ta macro, il est toujours très intéressant de voir comment
"d'autre(s)" font une macro que l'on ne sait pas soi-même appréhender ;
c'est peut-être là que l'on apprend le plus !...

Merci à toi

Antoine

' désactive le rafraîchissement de l'écran
Application.ScreenUpdating = False
' déclaration des variables du classement alphabétique
Dim a(256), j As Integer, k As Integer, n As Integer, temp
' comptage du nombre de feuilles
n = Sheets.Count
For j = 1 To n
a(j) = Sheets(j).Name
Next j
' tri des feuilles
For j = 1 To n
For k = j To n
If a(k) < a(j) Then
temp = a(k)
a(k) = a(j)
a(j) = temp
End If
Next k
Next j
' positionnement des feuilles selon la lettre
For j = 1 To n
Sheets(a(j)).Move before:=Sheets(j)
Next j
' déclaration des variables de la feuille sommaire
Dim wsh As Worksheet, i As Integer, H As Hyperlink, x As String,
R


As Range
' met la feuille Arrêt de travail type en Nième position des
feuilles
Sheets("Arrêt de travail type").Move After:=Sheets(Sheets.Count)
' met la feuille Sommaire en 1ère position des feuilles
Sheets("Sommaire").Move before:=Sheets(1)
' efface toutes les celules de la feuille Sommaire
Range("A:H").Select
Selection.ClearContents
' sélectionne la cellule B1 de la feuille "Sommaire"
Sheets("Sommaire").Select
' cycle de création des transfert de valeurs
Range("B1").Select
For Each wsh In ActiveWorkbook.Sheets
i = i + 1
' créé en colonne B un lien hypertexte pour toutes les feuilles du
classeur
ActiveSheet.Hyperlinks.Add Anchor:Îlls(i + 1, 1), Address:="",
_


SubAddress:="'" & wsh.Name & "'" & "!A1",
TextToDisplay:=wsh.Name
' transfert de la date/début (B9 de chaque feuille) sur la feuille
"Sommaire"
Cells(i + 1, 2) = wsh.Range("B9")
' transfert l'état "En cours/Soldé" (D4 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 3) = wsh.Range("D4")
' la remplace par la date de dernière I.J. de compagnie de chaque
feuille sur la feuille "Sommaire"
If Not LCase(Cells(i + 1, 3)) Like "en cours" Then Cells(i + 1,
3)


_
Application.WorksheetFunction.Max(wsh.Range("J9:J200"))



' transfert l'état "Cadre/Non Cadre" (C3 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 4) = wsh.Range("C3")
' transfert de la dernière I.J. Compagnie versée sur la feuille
"Sommaire"
Cells(i + 1, 5) = wsh.Range("N25")
' transfert du nombre de jours Compagnie (somme de P11 à P200) sur
la
feuille "Sommaire"
Cells(i + 1, 6) >> > Application.WorksheetFunction.Sum(wsh.Range("P11:P200"))
' transfert des I.J. totales versées /Compagnie (somme de K8 à
K200)
sur la feuille "Sommaire"
Cells(i + 1, 7) >> > Application.WorksheetFunction.Sum(wsh.Range("K9:K200"))
Next
' suprime le lien hyperT et les 3 cellules de droite de la 2ème
ligne
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Sommaire") Then
Set R = Range(H.Parent.Address)
R = "Salariés en arrêt"
Set R = R.Offset(0, 1)
R = "Début d' arrêt"
Set R = R.Offset(0, 1)
R = "Fin d' arrêt"
Set R = R.Offset(0, 1)
R = "Statut"
Set R = R.Offset(0, 1)
R = "I.J. Cie / jour"
Set R = R.Offset(0, 1)
R = "Nb. de jours"
Set R = R.Offset(0, 1)
R = "I.J. Cie cumulées"
H.Delete
End If
Next
' met en couleur les 7 cellules de titres
Range("A2:G2").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.ColorIndex = 9
End With
' supprime les 6 cellules de droite du lien hyperT de Arrêt de
travail
type
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Arrêt de travail type") Then
Set R = Range(H.Parent.Address)
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
End If
Next
' applique à A2 le format de cellule de B2
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
' réactive le rafraîchissement de l'écran
Application.ScreenUpdating = True
Range("A1").Select
End Sub




"Youky" 43c15d47$0$6661$
Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forum
la manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions

le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"
le rôle du $
pas sur de moi mais en principe cela fait que la variable est

considérée



comme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky

"Antoine76"
Bonsoir Youki,

Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près
:
je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source
sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de
l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message


:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."

J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!

Est-ce qu'il y a une solution pour le faire fonctionner en gardant
cette
Auto_Open (identique à tous les fichiers) ?

Petite question annexe, dans le code que tu as écris, je ne
comprends
pas


plusieurs petites chose que tu as écrites et qui fonctionnent très
bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une
variable




et
que je n'ai pas trouvé comme fonction ?

Dans tous les cas, Grand Merci pour ta contribution !

Antoine



"Youky" 43c033a0$0$19695$
Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu
inseres
un
module
et y mets cette macro et enregistre ton fichier dans le bon
répertoire





(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky

Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub

"Antoine76"
Bonjour à tous,

Je voudrais créer une macro, dans un fichier Excel vierge, qui
ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un
dossier






"Clients".
Chaque fichier de ce dossier contient, toujours sur la première
page,
une


liste qui commence à partir de la ligne 3 jusqu'à n, comme
ci-après






:

A B C D
E


F G
1 ( ligne vide pour touche
d'activation
de
macros
...)
2 Noms Début Fin Statut
I.J.






Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141


477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...

L'objectif de la macro de ce nouveau fichier, serait de
transférer,






pour
chaque fichier du dossier "Clients", toutes les lignes (à partir
de






la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présente


la mention "En cours", et, si possible, de faire précéder ce
transfert




de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la
1ère
feuille


du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de
la






macro,
ainsi que la composition de chaque fichier. Si nécessaire, je
peux
joindre


le fichier en cjoint...

Je ne sais pas comment faire pour créer une telle macro, et si il
est
possible de le faire sans ouvrir à chaque fois le fichier ?

Merci de vos conseils

Antoine






























Antoine76
Le #3456091
Bonjour Youki

Merci pour cette réponse qui a effectivement tout débloqué...

Ce qui me surprend cependant, c'est qu'en dépit du manque de chem & (que
j'aurai pu ou dû remarquer!), je ne comprends pas pourquoi cela a parfois
fonctionné, la seule chose qui puisse faire la différence étant la
localisation de ce fichier (et des autres bien sûr) :
- soit une boîte de test sur le bureau,
- soit directement dans mes documents,
- soit dans une boîte placée dans mes documents,
- soit dans une arborescence beaucoup plus complexe....

Quant à la présence de <>, cela vient initialment des tests que j'essayais
de faire... De là a germé l'idée de faire deux feuilles au lieu d'une, une
avec seulement les "En cours", l'autres avec les "Soldés", ce qui donne le
code ci-après. Si cela t'intéresse de voir le résultat final (ou supposé
tel), je te mets le fichier en Cjoint :

En 1er, le fichier satellite, avec macro (inchangé...),
en 2ème le fichier de centralisation de l'évolution des données - last
Edition ! :
N° 1 : http://cjoint.com/?bjwdXuxpKW

N° 2 : http://cjoint.com/?blgznga2Bq

Merci à toi encore

Antoine

Sub recapitulatif_arret_de_T()
' désactive le rafraîchissement de l'écran
Application.ScreenUpdating = False
' déclaration des variables
Dim a(200, 20)
Dim F, chemin As String
Dim b, i, k, lig, n, nl As Long
' efface le contenu de toutes les cellules des 2 feuilles
Sheets(2).Select
Cells.ClearContents
Sheets(1).Select
Cells.ClearContents
' décalle la 1ère ligne de copie de 2 lignes
lig = 2
' enregistre le chemin d'accès au fichier
chemin = ActiveWorkbook.Path & ""
' définit le nom du fichier variable du dossier des arrêt de travail
F = Dir$(chemin & "*.xls")
' boucle de recherche des fichiers du dossier des arrêts de travail
Do Until F = ""
' exclut de la boucle le fichier "Récapitulatif" et le fichier
"Formulaire"
If F = "Récapitulatif inter-entreprises des Arrêts de travail.xls" Or _
F = "Formulaires Arrêt de travail.xls" Then GoTo saute
' ouvre le fichier variable sur la feuille Sommaire
Application.ScreenUpdating = False
Workbooks.Open chemin & F
Application.ScreenUpdating = False
' sélectionne la feuille Sommaire
Sheets(1).Select
' boucle de transfert en fichier temporaire de la ligne 3 à la
dernière
n = 0
For k = 3 To [C65000].End(xlUp).Row
n = n + 1
'copie temporaire en colonne A du non de la société
a(n, 1) = [J1]
'copie temporaire en colonne B à I du reste de l'arrêt
For b = 1 To 8
a(n, b + 1) = Cells(k, b)
Next b
Next
' ferme le fichier variable
Workbooks(ActiveWorkbook.Name).Close savechanges:úlse
' transfert toutes les lignes temporaires sur la feuile En cours
For nl = 1 To n
lig = lig + 1
For k = 1 To 9
Cells(lig, k) = a(nl, k)
Next k
Next nl
' destination d'évitement de la boucle If Then
saute:
' sélectionne le fichier suivant
F = Dir$
Loop
' boucle de séléction des lignes Soldées
lig = 2
n = 0
' boucle de transfert en fichier temporaire de la ligne 3 à la dernière
For k = [C65000].End(xlUp).Row To 3 Step -1
'détecte les cellules Soldées
If Cells(k, 4) <> "En cours" Then
n = n + 1
'copie temporaire en colonne A à I des données de l'arrêt
For b = 1 To 9
a(n, b) = Cells(k, b)
Next b
' efface la ligne Soldée de la feuille En cours
Rows(k).Select
Selection.Delete Shift:=xlUp
End If
Next
' va sur la feuille Soldé
Sheets(2).Select
' transfère la mémoire provisoire sur la feuille 2
For nl = 1 To n
' sélection de la ligne
lig = lig + 1
' sélection des cellules A à I
For k = 1 To 9
Cells(lig, k) = a(nl, k)
' remplace le statut par un sigle pour les Soldés
If Cells(lig, 5) = "Non cadre" Then
Cells(lig, 5) = "NC"
ElseIf Cells(lig, 5) = "Cadre" Then
Cells(lig, 5) = "C"
ElseIf Cells(lig, 5) = "Cadre dirigeant" Then
Cells(lig, 5) = "CD"
End If
Next k
Next nl
' classe les colonnes A puis B par ordre croissant des lettres
Range("A3", [C65000].End(xlUp)).Select
Selection.Sort key1:=Range("A3"), order1:=xlAscending,
key2:=Range("B3"), order1:=xlAscending
' va sur la feuille En cours
Sheets(1).Select
' remise à zéro des paramètres
n = 0
lig = 2
' boucle de transfert en fichier temporaire de la ligne 3 à la dernière
For k = 3 To [C65000].End(xlUp).Row
'détecte les cellules En cours
If Cells(k, 4) = "En cours" Then
n = n + 1
'copie temporaire en colonne A à I des données de
l'arrêt
For b = 1 To 9
a(n, b) = Cells(k, b)
Next b
End If
Next
' efface le contenu de toutes les cellules de la feuille En cours
Cells.ClearContents
' transfère la mémoire provisoire sur la feuille 2
For nl = 1 To n
lig = lig + 1
' sélection des cellules A à I
For k = 1 To 9
Cells(lig, k) = a(nl, k)
Next k
Next nl
' classe les colonnes A puis B par ordre croissant des lettres
Range("A3", [C65000].End(xlUp)).Select
Selection.Sort key1:=Range("A3"), order1:=xlAscending,
key2:=Range("B3"), order1:=xlAscending
' réalise le format des cellules des 2 feuilles
For i = 1 To 2
ActiveWorkbook.Sheets(i).Select
' affiche le titre de chaque feuille
If i = 1 Then
Range("B1").Value = "Arrêts de travail en cours"
Else
Range("B1").Value = "Arrêts de travail soldés"
End If
' affiche la date de F1 à I1
Range("F1:G1").Select
ActiveCell.FormulaR1C1 = "Enregistré le"
Range("H1:I1").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Selection = Selection.Value
' met les titres des 9 cellules de la 2ème ligne
Range("A2").Value = "Entreprise"
Range("B2").Value = "Salarié en arrêt"
Range("C2").Value = "Début d' arrêt"
Range("D2").Value = "Fin d' arrêt"
Range("E2").Value = "Statut"
Range("F2").Value = "Salaire / jour"
Range("G2").Value = "I.J. Cie / jour"
Range("H2").Value = "Nb. de jours"
Range("I2").Value = "I.J. Cie cumulées"
' reproduit en A2 le format de la cellule B2
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
Range("A1").Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$2"
End With
ActiveSheet.PageSetup.PrintArea = ""
Next i
' va sur la feuille En cours
Sheets(1).Select
' réactive l'écran
Application.ScreenUpdating = True
End Sub



"Youky" 43c38e96$0$29180$
...
Publicité
Poster une réponse
Anonyme