[REGLE] - Ptite aide multi classeurs

[Paulo]

Bonjour,

J'ai un petit soucis et je ne vois pas comment le résoudre. Je vais essayer de vous l'expliquer en quelques mots :

1° Un classeur avec les jours de la semaine (Lundi à Samedi) séparés par feuille et des données dans chaque feuille (en A1 à A3 dans le fichier joint)
2° Ce classeur porte le nom correspondant au numéro semaine (S1 et S2 dans le fichier joint)
3° Un classeur résultat où je veux voir apparaitre les valeurs A1 à A3 pour chaque jour de la semaine (en jaune dans le classeur résumé)

Les autres données du classeur résumé ne sont pas forcément utile c'est juste pour se repérer.

Je voudrais donc que quand je rajoute une semaine il aille piocher les données directement dans le classeur correspondant qui sera créé manuellement (s3, s4 etc etc)

Merci d'avance pour votre aide.

 

[job75]

Re : Ptite aide multi classeurs

Bonjour Paulo,

Joli problème 🙂

La macro dans Feuil1 (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Target.Cells(1, 1)
If Target.Column > 1 Or Not IsNumeric(Target.Text) Then Exit Sub
Dim chemin$, fichier$, ouv As Boolean, w As Worksheet, ref As Range
'---création de la semaine---
If Target.Row > 8 Then
  Target.Offset(-7, 1).Resize(7).Copy Target.Offset(, 1)
  Target.Offset(-1, 2).AutoFill Target.Offset(-1, 2).Resize(8)
  Target.Offset(-1, 3).Resize(, 3).AutoFill Target.Offset(-1, 3).Resize(8, 3), xlFillFormats
End If
'--- ouverture du fichier s'il n'est pas ouvert---
chemin = ThisWorkbook.Path & "\" 'adapter éventuellement
fichier = "S" & Target & ".xls"
Application.ScreenUpdating = False
On Error Resume Next
If IsError(Workbooks(fichier).Name) Then
  Err = 0
  Workbooks.Open chemin & fichier
  If Err Then MsgBox "Fichier '" & fichier & "' introuvable !", 48: Exit Sub
  ouv = True
End If
On Error GoTo 0
'---copie des feuilles du fichier---
For Each w In Workbooks(fichier).Worksheets
  Set ref = Target.Offset(, 1).Resize(7).Find(w.Name, LookIn:=xlValues)
  If Not ref Is Nothing Then _
    ref.Offset(, 2).Resize(, 3) = Application.Transpose(w.[A1:A3])
Next
'---fermeture du fichier s'il a été ouvert---
If ouv Then Workbooks(fichier).Close False
End Sub

Fichiers joints. Les mettre tous les 3 dans le même répertoire (le bureau par exemple).

Nota : attention, il y avait des retours à la ligne dans les formules de la colonne B, je les ai supprimés.

A+

 

[job75]

Re : Ptite aide multi classeurs

Re,

Si les fichiers S2 S3 S4... sont modifiés, il faut mettre à jour le fichier résumé.

Vous avez sûrement compris qu'il suffit de revalider les cellules en colonne A.

C'est ce que fait le bouton Mise à jour avec cette macro :

Private Sub CommandButton1_Click() 'Mise à jour
Dim cel As Range
Application.ScreenUpdating = False
[D2:F65536].ClearContents
For Each cel In Range("A2", [A65536].End(xlUp))
  cel.Formula = cel.Formula 'revalidation de la formule
Next
End Sub

Avant de cliquer sur le bouton, voyez les cellules D2:F4, elles contiennent les formules de liaison mises par Paulo.

Après le clic, les formules ont disparu : de toute façon, elles n'étaient pas nécessaires.

A+

 

[job75]

Re : Ptite aide multi classeurs

Re,

Avec ce fichier (3) toutes les bordures colonnes B:C et D:F sont mises par MFC.

Cela a permis de supprimer une ligne de code.

A+

 

[job75]

Re : Ptite aide multi classeurs

Re,

Pour ceux qui sont un peu paresseux, j'ai créé le bouton Nouvelle semaine.

Et du coup, avec la variable flag (mémorisée), j'ai interdit la création manuelle d'un nouveau numéro :

Private Sub CommandButton2_Click() 'Nouvelle semaine
Dim derlig As Variant
flag = True
derlig = Application.Match(9 ^ 9, [A:A])
If IsError(derlig) Then MsgBox "Créez manuellement la semaine...": GoTo 1
Cells(derlig, 1).Resize(7).Copy Cells(derlig + 7, 1)
1 flag = False
End Sub

Fichier(4).

A+

 

[Paulo]

Re : Ptite aide multi classeurs

Merci pour toutes ces réponses, je regarde ça de plus près demain.

 

[Paulo]

Re : Ptite aide multi classeurs

Bon bein impeccable ça marche au poil, je vais adapter tout ça à mes feuilles maintenant 😉

Merci beaucoup pour la réactivité.

 

[Paulo]

Re : [REGLE] - Ptite aide multi classeurs

Ah malgré tout un ptit soucis, mes fichiers contiennent des espaces et j'ai une erreur quand je veux les ouvrir via cette ligne :

fichier = "S" & Target & ".xls"

J'ai remplacé par le format de mes fichiers :

fichier = "S." & Target & " CTR.xls"

Les fichiers sont tous sous cette forme :

S.1 CTR.xls
S.2 CTR.xls

etc etc etc

Et c'est bien au niveau de l'espace qu'il y a un soucis.

 

[job75]

Re : [REGLE] - Ptite aide multi classeurs

Re,

Je ne comprends pas, ce que vous indiquez est tout à fait correct...

Aucun souci avec les fichiers joints.

N'oubliez pas que les 3 fichiers doivent être dans le même répertoire (le bureau par exemple).

Edit : il y a peut-être 2 espaces...

Ou bien de "faux" espaces (caractère de code 160...).

A+

 

[Paulo]

Re : [REGLE] - Ptite aide multi classeurs

Pourtant j'ai bien une erreur, si je renomme le fichier sans espace (et que je change le nom dans le répertoire), ça fonctionne impeccable.

http://www.imagehotel.net/?from=kyaa1nlprn.png

 

[job75]

Re : [REGLE] - Ptite aide multi classeurs

Re,

Voyez l'Edit du post #9.

Mes 3 fichiers fonctionnent non ???

Je ne peux rien vous dire de plus.

A+

 

[Paulo]

Re : [REGLE] - Ptite aide multi classeurs

Hum oui ça fonctionne, j'avais inversé les lettres du fichier "CRT" au lieu de "CTR"...

Je sors discrètement sur la pointe des pieds, merci beaucoup pour l'aide 😉