Erreur code sur TCD

Bonjour,

Dans le fichier joint, il y a un beug sur la macro pour utiliser un TCD!

Je n'arrive pas à trouver d'où vient le problème!!!

Merci d'avance pour votre aide...

Cdlt

Galiax

bonjour,

quand un nom de feuille contenant des espaces est utilisé dans une formule, il doit être mis entre caractères '

une correction, cela corrige l'erreur sur l'instruction, je n'ai pas pu vérifier si le résultat était correct, ton fichier ne le permettant pas.

Sub TDC()

     Set dict = CreateObject("scripting.dictionary")     'cahier de brouillon
     dict.comparemode = vbTextCompare     'ignore majuscules
     For Each wk In ThisWorkbook.Worksheets     'boucle les feuilles
          If Not wk.Name Like "Recap *" Then     'ignore cette feuille
               With wk
                    ref = "'" & .Name & "'!" & Range("B10:B2000").Address   'cherchez dans cette plage
                    formule = "=if(" & ref & "=""total hrs tvail"",row(" & ref & "),if(" & ref & "=""jour"",-row(" & ref & "),""~""))"
                    arr = Filter(Application.Transpose(Evaluate(formule)), "~", 0)     '---> un array avec les lignes "jour" (negatif) et les lignes "total hrs tval" (pos)
                    For i = 0 To UBound(arr) - 1     'boucle cet array
                         If arr(i) < 0 And arr(i + 1) > 0 Then     'normallement un valeur negatif (jour) suivi par un valeur positif (total hrs tvail), autrement problème majeur
                              For j = 3 To 12     'attention, il y a des cellules fusionnées
Debug.Print .Cells(-arr(i), j).Value2 & "   " & .Cells(arr(i + 1), j).Value
                                   Set c1 = .Cells(-arr(i), j).MergeArea.Cells(1)     'probleme avec ces cellules fusionnées
                                   Set c2 = .Cells(arr(i + 1), j).MergeArea.Cells(1)
                                   If c1.Value <> "" And c2.Value <> 0 Then dict.Add dict.Count, Array(.Name, c1.Value2, c2.Value, c1.Address, c2.Address)     'ajouter au dictionary
                              Next
                         End If
                    Next
               End With
          End If
     Next

     With Sheets("TCD Recap heure travaillé").ListObjects("TBL_Resume")     'ce tableau
          If .ListRows.Count Then .DataBodyRange.Delete     'vider
          If dict.Count Then
               arr = Application.Index(dict.items, 0, 0)     'items >>> array
               .ListRows.Add.Range.Range("A1").Resize(UBound(arr), UBound(arr, 2)).Value = arr     'array >>> plage
          End If
     End With

     ThisWorkbook.RefreshAll
End Sub

Bonjour h2so4,

merci pour la modif, je l'ai adapté sur un autre fichier (voir PJ) mais ça ne résume pas les données?!

Si tu peux y jeter un coup d'œil, je t'en remercie.

A++

!

Bonjour, Bonsoir,

merci pour la modif, je l'ai adapté sur un autre fichier (voir PJ) mais ça ne résume pas les données?!

Si tu peux y jeter un coup d'œil, je t'en remercie.

c'est peut-être plus efficace de demander à celui qui t'a fait le code ?

bonjour,

il y avait un petit point d'intérêt, "Like" est sensible aux majuscules et minuscules, c'était pourquoi la première ligne du module était "Option Compare Text" mais autrement, on pouvait aussi résoudre ce problème avec un "Ucase" (mettre tout en majuscules). Mais le nom de la feuille était la cause principale, un "a" et un "e" >>> "RACAP" au lieu de "Recap"

          If Not UCase(wk.Name) Like "RACAP *" Then     'ignore cette feuille