Macro sous Excel 2003 qui BUG avec Excel2010

Bonjour forum,

voilà déjà quelques années, on m'a construit une macro qui transpose des données disposées en collone dans un feuillet vers

2 autres feuillets mais cette fois, disposées sur des lignes. Alors que la macro fonctionnait bien avec mon vieil ordi et

sous Excel 2003, voilà que maintenant la macro "bug". Le problème semble provenir du fait que le filtrage (selon les dates)

ne semble plus être bien compris, ce qui fait planter la macro par la suite. Voilà la macro:

Sub Pluie_Neige_Tranpose()

' Macro enregistrée le 2012-11-19 

Dim J As Long, Ligne As Long, NbLig As Long
Dim I As Integer, K As Integer, Colonne As Integer
Dim Mondico As Object
Dim Ws(2) As Worksheet
Dim Tablo
Dim Cel As Range, Cel1 As Range

  Application.ScreenUpdating = False
  Set Ws(0) = Sheets("Pluie")
  Set Ws(1) = Sheets("Neige")
  Set Ws(2) = Sheets("Tous")

  If Ws(2).AutoFilterMode = True Then Ws(2).AutoFilterMode = False
  NbLig = Ws(2).Range("A" & Rows.Count).End(xlUp).Row

  Ws(0).Cells.ClearContents
  Ws(1).Cells.ClearContents
  Ws(0).Range("A1:F1") = Array("ID", "Nom de la station", "Rgn", "Lat", "Lon", "Elevation")
  Ws(1).Range("A1:F1") = Array("ID", "Nom de la station", "Rgn", "Lat", "Lon", "Elevation")

  ' Création d'une liste des dates uniques
  Set Mondico = CreateObject("Scripting.dictionary")
  For J = 2 To NbLig
    Mondico(Ws(2).Range("G" & J).Value) = ""
  Next J

  Ws(0).Range("G1").Resize(1, Mondico.Count) = Mondico.keys
  Ws(1).Range("G1").Resize(1, Mondico.Count) = Mondico.keys

  Colonne = 7         ' Colonne de reception des 1ères données

  Tablo = Mondico.keys
  For I = 0 To UBound(Tablo)    ' Pour toutes les dates    ' Filtre les données
    Ws(2).Range("A1:O" & NbLig).AutoFilter Field:=7, Criteria1:=DateValue(Tablo(I))

    ' Pour chaque résultat
    For Each Cel In Ws(2).Range("A2:A" & NbLig).SpecialCells(xlCellTypeVisible)
      For K = 0 To 1    ' Dans les 2 feuilles

        ' Recherche si l'ID existe
        Set Cel1 = Ws(K).Columns("A").Find(what:=Cel, LookIn:=xlValues, lookat:=xlWhole)
        If Not Cel1 Is Nothing Then
        Ligne = Cel1.Row    ' ID existe
        Else                                            ' Id n'existe pas on le crée
            Ligne = Ws(K).Range("A" & Rows.Count).End(xlUp).Row + 1
            Ws(2).Range("A" & Cel.Row).Resize(1, 6).Copy Ws(K).Range("A" & Ligne)
      End If

        ' On copie l'information correspondante
        Ws(K).Cells(Ligne, Colonne) = Cel.Offset(0, 9 + K)  '9 pour copier 10 et 11ième col.

         'Dans le feuillet: "Pluie"
            'If K = 0 And IsNumeric(Ws(K).Cells(Ligne, Colonne)) And Ws(K).Cells(Ligne, Colonne) >= 25 And Ws(K).Cells(Ligne, Colonne) < 50 Then
             '   Ws(K).Cells(Ligne, Colonne).Interior.Color = 65535  'on colore jaune: cellules entre 25 et 50
           ' End If

            'If K = 0 And IsNumeric(Ws(K).Cells(Ligne, Colonne)) And Ws(K).Cells(Ligne, Colonne) >= 50 Then
             '   Ws(K).Cells(Ligne, Colonne).Interior.Color = 255  'on colore rouge: cellules >= 50
            'End If

        'Dans le feuillet: "Neige"
           ' If K = 1 And IsNumeric(Ws(K).Cells(Ligne, Colonne)) And Ws(K).Cells(Ligne, Colonne) >= 10 And Ws(K).Cells(Ligne, Colonne) < 15 Then
             '   Ws(K).Cells(Ligne, Colonne).Interior.Color = 65535  'on colore jaune: cellules entre 10 et 15
            'End If

            'If K = 1 And IsNumeric(Ws(K).Cells(Ligne, Colonne)) And Ws(K).Cells(Ligne, Colonne) >= 15 Then
             '   Ws(K).Cells(Ligne, Colonne).Interior.Color = 255  'on colore rouge: cellules >= 15
            'End If
    'End If

        Next K
    Next Cel
    Colonne = Colonne + 1           ' La prochaine date filtrée ira dans cette colonne
  Next I
  Ws(2).AutoFilterMode = False
End Sub

Quelqu'un a un idée pour résoudre le problème?

Je fournis un fichier simplifié.

En vous remerciant d'avance

Émil

bonjour,

ton classeur ne donne pas de problème avec ma version 2010 UK.

Bonjour H2SO4,

il est bien possible que le problème soit aussi lié au faut que j'ai une version Canadien anglaise autant pour Excel. D'autre part, je me demande si le tout n'est pas lié à ma config (sous Window 7). Y-at'il moyen de filtrer autrment que par les dates ?

Emil

Bonjour

Remplace ton filtre par celui-ci

    Ws(2).Range("A1:O" & NbLig).AutoFilter Field:=7, Criteria1:=">=" & CSng(Tablo(I)), Operator:=xlAnd, Criteria2:="<=" & CSng(Tablo(I)) 

Pas de plantage avec XL 2003 FR ni avec XL 2010 FR

Bonjour Banzai64,

j'ai modifié la macro tel que prescrit et tout fonctionne à merveille!

Je vous remercie.

Émil