Macro Complexe Copier-Coller en valeur

albane_44

XLDnaute Nouveau
Bonjour à tous!

Dans le cadre de mon travail, j'ai à réaliser un fichier de chiffrage quelque peu automatisé et je bloque dans le développement de ma macro.

Voici le principe d'utilisation de ce fichier appelé "FichierExemple2".

Ce fichier composé de 2 onglets, permet de compléter le 2ème onglets à partir du 1er.
Une fois le 1er onglet complété, l'activation de la macro permet de :"

1) ouvrir un fichier similaire sur un serveur qui se compose que des 4 derniers onglets,
2) Copier en valeur toutes les cases en jaunes pâle du 2ème onglets du FichierExemple, et les coller en valeur dans le fichier ouvert en 1).
3) Une fois cette manipulation effectuée, enregistrer ce nouveau fichier (nom+chemin).

Je pense maitriser le point 1) et 3), mais rencontre un soucis dans le point 2).

Es ce que mon code est trop lourd? long à exécuter?


Merci de votre aide!


Albane
 

Pièces jointes

  • FichierExemple2.xlsm
    109.3 KB · Affichages: 36
Dernière édition:

thebenoit59

XLDnaute Accro
Re : Macro Complexe Copier-Coller en valeur

Bonjour René, Albane.
Et le LLig correspond à la dernière ligne trouvée dans ton tableau. C'est une variable que j'ai définit au début du code.
Le premier code se limitait à une longueur de tableau tandis que le nouveau se limitera automatiquement à la dernière ligne trouvée.
 

albane_44

XLDnaute Nouveau
Re : Macro Complexe Copier-Coller en valeur

Après quelques adaptations à mon nouveau fichier, j'ai enfin réussi et cela fonctionne parfaitement! Quelques longueurs d'éxécution, mais 10secondes tout au plus!

J'aimerai pour finir affiner le résultat obtenu avec une autre intervention qui me permettrait de ne pas copier la cellule jaune pâle si celle-ci est vide, car le résultat sur mon fichier client est un zéro alors que je voudrais un ensemble vide.
Pourriez vous me guider sur cette dernière manip svp?

Le code est donc le suivant :

Sub DetecterCellulesACopier()

Dim WbkS As Workbook ' Classeur source
Set WbkS = ThisWorkbook

Dim WbkD As Workbook ' Classeur de Destination
Dim fichier As String
fichier = "//////".xlsm"

'--- Exportation des données Onglet Chiffrage vers fichier client

WbkS.Worksheets("Chiffrage").Activate

Dim Couleur As String, NbCellules As Integer, LLig As Long, Adresse As Range

'--- On détermine la dernière ligne et le code couleur des cellules à copier
LLig = Cells.Find("*", , , , xlByRows, xlPrevious).Row
Couleur = Range("L1").Interior.Color

'--- On enregistre les données dans un dictionary
Set d = CreateObject("Scripting.Dictionary")
For Each Cell In Range(Cells(1, 1), Cells(LLig, 13))
If Cell.Interior.Color = Couleur Then d(Cell.Address) = Cell.Value
Next Cell

'--- On ouvre le fichier client
Set WbkD = Workbooks.Open(fichier)

'--- On boucle les données du tableau pour les importer dans le fichier client
For Each c In d.Keys
Range(c) = d(c)
Next c
End sub

Il faudrait intervenir à ce niveau là je pense en rajoutant une condition après le if pour la couleur :

For Each Cell In Range(Cells(1, 1), Cells(LLig, 13))
If Cell.Interior.Color = Couleur Then d(Cell.Address) = Cell.Value


Merci à vous !
A.
 

Discussions similaires

Réponses
12
Affichages
227

Statistiques des forums

Discussions
312 073
Messages
2 085 058
Membres
102 768
dernier inscrit
clem135164