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.