Rapport de message :*
 

Re: Recherche valeur.

Titre du sujet : Re: Recherche valeur.
par michel_m le 28/05/2010 10:48:06

Bonjour,

essaies ce code:
Option Base 1
Sub recapituler()
Dim dercol As Byte, entete As String, cptr As Byte, nbre As Integer
Dim tablo
Dim lig As Integer, donnee As Byte
dercol = Sheets("récap").Range("IV3").End(xlToLeft).Column
entete = Range("B3")
 With Sheets("données")
    nbre = Application.CountIf(.Columns(2), entete)
    ReDim tablo(dercol - 1, nbre)
    For cptr = 2 To dercol
        entete = Sheets("récap").Cells(3, cptr)
        lig = 1
        donnee = 1
        For cptr_donn = 1 To nbre
            lig = .Columns(2).Find(entete, .Cells(lig, 2)).Row
            tablo(cptr - 1, donnee) = Replace(.Cells(lig, 3), "-", 0)
            donnee = donnee + 1
        Next
    Next
End With

Application.ScreenUpdating = False
With Sheets("récap")
    .Range("B4").Resize(nbre, dercol - 1) = Application.Transpose(tablo)
    .Activate
End With


End Sub