Transférer des données dans différentes feuilles
Bonjour à tous,
J'ai un problème pour concevoir une macro qui me permettrait de transférer des données de feuilles (données) au d'autres feuilles (résultats). Je joins à cette demande un fichier "Modèle" et un fichier "Exemple".
Le problème est le suivant : je dispose de 7 sept feuilles (couleur verte) qui représentent les applications (CVCA, PLOMBERIE, ELECTRICITE, PISCINE, GENERATRICE, REFRIGERATION & AUTRES). Dans chacune de ces feuilles la colonne "E" est celle des transferts de données. A la droite de ces feuilles, on retrouve les feuilles de données (dans le cas du fichier modèle : 1 seule feuille de données & dans le cas du fichier exemple : 7 feuilles). Il y a toujours 7 feuilles d'applications mais il peut y avoir de nombreuses feuilles de données.
J'aimerais qu'il soit conçu une macro qui permet de transférer les données de la première feuilles de données jusqu'à la dernière dans les feuilles d'applications correspondantes selon les affectations décrites dans la feuille1 du fichier "modèle". Le lien qui unit une feuille de données avec une feuille d'application est dans la feuille de données, cellule "I6". Pour chacune des feuilles de données, la macro devra associer l'application incluse dans la cellule 'I6" à la bonne feuille d'application et copier les données numérotées de 1 à 22 dans cette feuille. Lorsqu'on retrouve une application en 'I6' identique dans une autre feuille de données, la macro devra copier les colonnes vierges "D" et "E" dans les colonnes "F" & "G", y affecter le chiffre 2 en "G1" et copier les données contenues dans la feuilles de données et ainsi de suite jusqu'à la dernière feuilles de données soit atteinte.
Votre aide sera fortement appréciée.
Merci à l'avance,
Salutations,
Renaud D.
Bonsoir,
ai-je bien compris qu'il manque quelque chose dans ton fichier exemple ? (je n'y trouve pas l'application dans les feuilles de données) or cette donnée est essentielle pour pouvoir faire le traitement ?
Bonsoir h2so4,
L'application dans chacune des feuilles de données se retrouve dans les cellules "I6".
Merci pour l'intérêt que tu montres à mon problème.
Salutations,
Renaud D.
bonsoir,
effectivement il y a bien quelque chose en I6 (à peine visible pour mes yeux ...), désolé de n'avoir pas bien regardé
voici une proposition de macro à tester.
Sub creefiche()
' raz des fiches applications
For Each f In Array("CVCA", "PLOMBERIE", "ELECTRICITE", "PISCINE", "GENERATRICE", "REFRIGERATION", "AUTRES")
Worksheets(f).Columns("E:ZZ").ClearContents
Next
' copie des données dans les fiches applications
For Each ws In Worksheets
If ws.Range("B3") = "Équipement :" Then ' feuille données
f = ws.Range("I6")
Set wsa = Worksheets(f)
col = wsa.Range("ZB5").End(xlToLeft).Column
If col = 2 Then col = 3
col = col + 2
wsa.Cells(5, col) = ws.Range("C8") '1
wsa.Cells(6, col) = ws.Range("C7") '2
wsa.Cells(7, col) = ws.Range("C3") '3
wsa.Cells(8, col) = ws.Range("I6") '4
wsa.Cells(9, col) = ws.Range("N4") '5
wsa.Cells(10, col) = ws.Range("N6") '6
wsa.Cells(11, col) = ws.Range("N7") '7
wsa.Cells(12, col) = ws.Range("D33") '8
wsa.Cells(13, col) = ws.Range("D34") '9
wsa.Cells(14, col) = ws.Range("D35") '10
wsa.Cells(15, col) = ws.Range("D36") '11
wsa.Cells(16, col) = ws.Range("D37") '12
wsa.Cells(17, col) = ws.Range("D40") '13
wsa.Cells(20, col) = ws.Range("O47") '14
wsa.Cells(21, col) = ws.Range("P47") '15
wsa.Cells(28, col) = ws.Range("B10") '16
wsa.Cells(29, col) = ws.Range("B26") '17
wsa.Cells(32, col) = ws.Range("c44") '18
wsa.Cells(33, col) = ws.Range("c45") '19
wsa.Cells(34, col) = ws.Range("c46") '20
wsa.Cells(35, col) = ws.Range("c47") '21
wsa.Cells(36, col) = ws.Range("c48") '22
End If
Next
Set wsa = Nothing
Set ws = Nothing
End SubMerci beaucoup h2so4 pour ta réponse. A première vue, ta macro fonctionne très bien.
Étant très occupé actuellement, je prendrais un peu de temps pour bien analyser le comportement de ta macro et je te reviendrai bientôt avec quelques observations. Merci encore.
Salutations,
Renaud
Bonjour h2so4,
J'ai été très occupé ces derniers temps et je n'est pu travailler sur la macro que vous avez brillamment conçue le 18 décembre dernier. Cette macro fonctionne parfaitement et je t'en remercie. Cependant, j'aimerais que vous m'aidiez à ajouter et améliorer certaines petites choses.
Premièrement, je voudrais qu'à chaque élément copié un numéro incrémenté de 1 soit ajouté comme dans le fichier Exemple.xlsx (exemple CVCA : Cellule E1 : 1, cellule G1 : 2, cellule I1 : 3,... ) Idem pour les autres feuilles d'applications.
Deuxièmement, il faudrait qu'aucune formule dans les feuilles d'application (ex. : cellule E22 (=$C3-E15), E23 (=E20-E22+$C3), E24 (=E20-E22+(E21)+$C3),E27, ...) ne soit altérée lors de la copie des données.
Troisièmement, il faudrait que les données copiées dans les feuilles d'application soient tous en caractères normaux (non gras) et que les lignes de bordure soient copiées lorsqu'un nouvel équipement est copié (présentation identique au fichier : Exemple.xlsx)
Quatrièmement, que la zone d'impression des feuilles d'application soit définie uniquement en fonction des données transférées.
Extra :
J'aimerais savoir s'il est possible d'ajouter à ta macro une fonction de tri. Après avoir copié toutes les données dans les feuilles d'application, une boîte de dialogue pourrait s'ouvrir et me demander de trier ou pas les données copiées en fonction du FABRICANT (1er niveau de tri) et du modèle (2ème niveau de tri). Une autre macro permettrait de rétablir la version originale et d'obtenir les mêmes données copiées initialement (par ordre de 1, 2 , 3,...)
Finalement, j'aimerais savoir s'il est possible de concevoir un programme qui permettrait de copier automatiquement, un montant X (calculé à partir d'entrées de données manuelles en D, F, H,...) comprises dans les cellules E26, G26, I26,... de chacune des applications et les transférer dans les bonnes feuilles de données dans les cellules O45 correspondantes (voir fichier Exemple 2.xlsx ci-joint pour le CVCA, idem pour les autres applications). Le lien entre les feuilles de données et les données incluses dans les feuilles d'application serait le n° ID qui permettra de transférer les montants dans les bonnes fiches de données.
Je sais que mes demandes sont nombreuses et je vous remercie à l'avance si vous pourriez m'aider.
Sincères salutations,
Renaud D.
Bonjour,
une partie de la réponse, l'extra n'est pas compris.
Sub creefiche()
' raz des fiches applications
Application.EnableEvents = False
For Each f In Array("CVCA", "PLOMBERIE", "ELECTRICITE", "PISCINE", "GENERATRICE", "REFRIGERATION", "AUTRES")
Worksheets(f).Range("E1:ZB36").ClearContents
Next
' copie des données dans les fiches applications
For Each ws In Worksheets
If ws.Range("B3") = "Équipement :" Then ' feuille données
f = ws.Range("I6")
Set wsa = Worksheets(f)
col = wsa.Range("ZB5").End(xlToLeft).Column
If col = 2 Then col = 3
col = col + 2
nc = (col - 3) / 2
If nc <> 1 Then wsa.Range("D1:E104").Copy wsa.Cells(1, col - 1)
wsa.Cells(1, col) = nc
wsa.Cells(5, col) = ws.Range("C8") '1
wsa.Cells(6, col) = ws.Range("C7") '2
wsa.Cells(7, col) = ws.Range("C3") '3
wsa.Cells(8, col) = ws.Range("I6") '4
wsa.Cells(9, col) = ws.Range("N4") '5
wsa.Cells(10, col) = ws.Range("N6") '6
wsa.Cells(11, col) = ws.Range("N7") '7
wsa.Cells(12, col) = ws.Range("D33") '8
wsa.Cells(13, col) = ws.Range("D34") '9
wsa.Cells(14, col) = ws.Range("D35") '10
wsa.Cells(15, col) = ws.Range("D36") '11
wsa.Cells(16, col) = ws.Range("D37") '12
wsa.Cells(17, col) = ws.Range("D40") '13
wsa.Cells(20, col) = ws.Range("O47") '14
wsa.Cells(21, col) = ws.Range("P47") '15
'E22=$C3-E15
wsa.Cells(22, col).FormulaR1C1 = "=R3C3-R15C" & col
' E23=E20-E22+$C3
wsa.Cells(23, col).FormulaR1C1 = "=R20C" & col & "-R22C" & col & "+R3C3"
'E24=E20-E22+(E21)+$C3
wsa.Cells(24, col).FormulaR1C1 = "=R20C" & col & "-R22C" & col & "+R21" & col & "+R3C3"
'E26=E94
wsa.Cells(26, col).FormulaR1C1 = "=R94C"
'E46-E92 (sauf E60-E61 et E76-E77)=D46-D92*100
wsa.Cells(46, col).FormulaR1C1 = "=rc[-1]*100"
wsa.Cells(46, col).Copy wsa.Range(wsa.Cells(47, col), wsa.Cells(59, col))
wsa.Cells(46, col).Copy wsa.Range(wsa.Cells(62, col), wsa.Cells(75, col))
wsa.Cells(46, col).Copy wsa.Range(wsa.Cells(78, col), wsa.Cells(92, col))
'E94=sum(E46:E59)+sum(E62:E75)+sum(E78:E92)
wsa.Cells(94, col).FormulaR1C1 = "=sum(R46C:R59C)+sum(R62C:R75C)+sum(R78c:R92c)"
wsa.Cells(28, col) = ws.Range("B10") '16
wsa.Cells(29, col) = ws.Range("B26") '17
wsa.Cells(32, col) = ws.Range("c44") '18
wsa.Cells(33, col) = ws.Range("c45") '19
wsa.Cells(34, col) = ws.Range("c46") '20
wsa.Cells(35, col) = ws.Range("c47") '21
wsa.Cells(36, col) = ws.Range("c48") '22
'
wsa.Range(wsa.Cells(46, col - 1), wsa.Cells(94, col - 1)).ClearContents
'enlever bold
wsa.Range("C3:" & Cells(104, col).Address).Font.Bold = False
' définir zone d'impression
wsa.PageSetup.PrintArea = wsa.Cells(1, 1).Address & ":" & wsa.Cells(104, col).Address
End If
Next
Application.EnableEvents = True
Set wsa = Nothing
Set ws = Nothing
End Subvoici une macro pour trier les fiches suivant le fabricant et le modèle
Sub trifiche()
Dim clétri(100) As String, clétriindex(100)
For Each f In Array("CVCA", "PLOMBERIE", "ELECTRICITE", "PISCINE", "GENERATRICE", "REFRIGERATION", "AUTRES")
Set wsa = Worksheets(f)
i = 5
While wsa.Cells(1, i) <> ""
n = wsa.Cells(1, i)
clétri(n) = wsa.Cells(12, i) & wsa.Cells(13, i)
clétriindex(n) = n
i = i + 2
Wend
For i = 1 To n - 1
For j = i + 1 To n
If clétri(clétriindex(i)) > clétri(clétriindex(j)) Then a = clétriindex(i): clétriindex(i) = clétriindex(j): clétriindex(j) = a
Next j
Next i
For i = 1 To n
col = 3 + clétriindex(i) * 2
coln = 3 + (n + i) * 2
wsa.Range(Cells(3, col - 1).Address & ":" & Cells(104, col).Address).Copy wsa.Cells(3, coln - 1)
Next i
wsa.Range(Cells(3, 4).Address & ":" & Cells(104, 3 + n * 2).Address).Delete shift:=xlToLeft
Next
End Subpour retrouver l'ordre initial, relancer la macro créefiche.
pour avoir la mise-à-jour automatique de O45 dans les fiches sur base de la valeur en ligne 26 des onglets applications
ajouter cette macro dans le code de thisworkbook.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Row < 46 Or (Target.Column Mod 2) <> 0 Then Exit Sub
Application.EnableEvents = False
Select Case Sh.Name
Case "CVCA", "PLOMBERIE", "ELECTRICITE", "PISCINE", "GENERATRICE", "REFRIGERATION", "AUTRES"
Worksheets(Cells(5, Target.Column + 1) & "_" & Cells(6, Target.Column + 1)).Range("O45") = Sh.Cells(26, Target.Column + 1).Value
End Select
Application.EnableEvents = True
End SubBonjour h2so4,
Merci infiniment pour votre aide.
J'ai pris quelques jours pour tester les macros que vous avez si bien conçues. Concernant la macro utilisée pour le transfert de données, j'ai testé la macro du 18 décembre sur des feuilles de 100 équipements et la macro du 4 janvier sur des feuilles vierges. J'ai constaté que la macro du 18 décembre est deux fois plus rapide que celle du 4 janvier. Il est donc plus intéressant de ne pas utiliser la fonction pour effacer l'ensemble des données mais de démarrer à partir des feuilles d'application vierges (voir fichier Exemple 3.xlsm ci-joint) contenant toutes les formules et de transférer uniquement les données dans les colonnes appropriées. Les formules (j'en ai ajouté plusieurs) et la mise en page ne seront donc pas affectées.
Votre macro de tri fonctionne parfaitement. Cependant, il faudrait modifier votre macro du 18 décembre afin d'éliminer toutes les colonnes vierges situées à droite des données transférées dans l'ensemble des feuilles d'applications. De cette façon, on obtiendra exclusivement des colonnes contenant les données transférées et on pourra alors utiliser efficacement votre macro de tri en fonction du fabricant et du modèle.
Dans le fichier , version finale "Exemple3.xlsm", d'autres cellules d'entrées de données ont été ajoutées ainsi que quelques lignes. Suite aux transferts de données, on pourra entrer des données manuellement dans les cellules représentées en rouge dans la feuille d'applications "CVCA" ). Idem pour tous les autres équipements et feuilles d'applications. Votre macro qui permet de copier automatiquement, un montant X (calculé à partir d'entrées de données manuelles en D, F, H,...) comprises dans les cellules E26, G26, I26,... de chacune des applications et les transférer dans les bonnes feuilles de données dans les cellules O45 correspondantes fonctionne très bien. Cependant, quand j'entre une donnée dans les cellules E42, G42, I42, ... le montant calculé en E26, G26, I26,... n'est pas automatiquement transférer à la cellule O45 correspondant à l'équipement. Je dois obligatoirement entrer une données dans les lignes > 46 / colonne D, F,.... Pourriez-vous m'aider à corriger ce problème également.
Soyez assuré que j'apprécié énormément le travail que vous avez fait et l'aide précieuse apportée. Au plaisir de vous lire.
Sincères salutations,
Renaud D.
Fichier "Exemple 3.xlsm ci-joint"
Bonjour h2so4,
Veuillez noter que j'ai dû supprimer 6 feuilles d'applications et 5 équipements car le fichier Excel excédait 300 ko.
Sincères salutations,
Renaud D.
Bonjour h2so4,
Je viens simplement vous demander si vous avez eu le temps de jeter un petit coup d'oeil à mon message du 7 janvier dernier et si vous aurez amabilité d'effectuer les modifications requises.
Dans l'attente de vous lire,
Sincères salutations,
Renaud D.
Bonjour h2so4,
Je viens simplement vous demander si vous avez eu le temps de jeter un petit coup d'oeil à mon message du 7 janvier dernier et si vous aurez amabilité d'effectuer les modifications requises.
Dans l'attente de vous lire,
Sincères salutations,
Renaud D.
Bonsoir,
1) oui j'ai eu l'occasion de lire le message et je suis désolé de ne pas être 100% à ta disposition pour réagir au quart de tour.
2) pour les adaptations demandées : voir fichier, j'y ai rajouté une feuille modèle qui sert à réinitialiser les feuilles applications.
(disponible 21 jours)
Bonjour h2so4,
Je voudrais m'excuser de l'insistance donc j'ai fait part dernièrement. Mon patron pour qui je dois faire ce travail me demande régulièrement des comptes-rendus. Il me demandera probablement, dans un avenir plus ou moins rapproché, d'autres macros sur d'autres types de transferts de données. Je sais que vous rendez de précieux services et ce à titre gracieux et je l'apprécie énormément.
Je tiens également à vous remercier et féliciter pour le travail que vous avez fait. Le transfert de données et le tri fonctionnent à merveille.
Cependant, le transfert des valeurs en E26, G26, I26,... dans les différentes feuilles d'application vers les cellules O45 correspondantes à chaque équipement ne se fait pas automatiquement. Quand j'entre une donnée (voir fichier Exemple 4.xlsm : en rouge les cellules potentielles d'entrées de données) dans les cellules E42, G42, I42, ... ou E79@E90, G79@G90,.. ou E94, G94,... (cellules en rouge), le montant calculé en E26, G26, I26,... n'est pas automatiquement transféré à la cellule O45 de l'équipement. Je dois obligatoirement entrer une donnée dans les cellules D48@D59, F48@F59,.. ou D64@D75, G64@G75,.... afin que la cellule O45 de l'équipement soit automatiquement mis à jour.
Quand vous aurez une minute, pourriez-vous, s'il vous plait, m'aider à corriger ce problème.
Sincères salutations,
Renaud D.
PS : Fichier Exemple 4.xlsm : Les feuilles d'applications "PLOMBERIE", "ELECTRICITE", "PISCINE", "GENERATRICE", "REFRIGERATION", "AUTRES" ont été supprimées en raison de la capacité limite de 300 ko pour les fichiers joints.
Bonsoir,
remplace le code de thisworkbook par celui-ci.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
r = Target.Row
c = Target.Column
If ((r > 47 And r < 60) Or (r > 63 And r < 76)) And (c Mod 2) = 0 And c > 2 Then
tc = 1
ElseIf (r = 42 Or (r > 78 And rr < 91) Or r = 94) And (c Mod 2) = 1 And c > 3 Then
tc = 0
Else
Exit Sub
End If
Application.EnableEvents = False
Select Case Sh.Name
Case "CVCA", "PLOMBERIE", "ELECTRICITE", "PISCINE", "GENERATRICE", "REFRIGERATION", "AUTRES"
Worksheets(Cells(5, Target.Column + tc) & "_" & Cells(6, Target.Column + tc)).Range("O45") = Sh.Cells(26, Target.Column + tc).Value
End Select
Application.EnableEvents = True
End SubJe voudrais m'excuser de l'insistance donc j'ai fait part dernièrement. Mon patron pour qui je dois faire ce travail me demande régulièrement des comptes-rendus
soit ton patron peut se satisfaire d'un timing de bénévole soit il choisit de payer, il y a assez d'offres pour ce genre de services.
Bonjour h2so4,
Merci encore pour votre aide. Votre dernière macro fonctionne parfaitement.
Vous avez fait un excellent travail.
Sincères salutations,
Renaud D.