Re : identifier code et dates correspondantes
Alors,
j'ai inséré la ligne à la suite et changer dans "msgbox" la valeur FCbl en place de feuille 106
J'ai une erreur d’exécution "9" -- " l'indice n'appartient pas à la sélection"
Sub Collecte(ByVal FCbl As Worksheet)
Dim FSrc As Worksheet, Cel As Range, Déb As Date, Te(), Codes(), Périodes(), DCV As New Dictionary, _
Valide As Boolean, L As Long, J As Long, Jp As Long, CodCou As String, CodSui As String
On Error Resume Next
Set FSrc = ThisWorkbook.Worksheets(FCbl.[AD4].Value)
If Err Then MsgBox "Feuille """ & FCbl.[AD4].Value & """ introuvable.", vbCritical, "Collecte": Exit Sub
On Error GoTo 0
Te = FCbl.Range("U2:U" & FCbl.[U500].End(xlUp).Row).Value
For L = 1 To UBound(Te)
If Not IsEmpty(Te(L, 1)) Then DCV(UCase(Te(L, 1))) = 0
Next L
Déb = FSrc.[C8].Value - 1
Set Cel = FSrc.[A9:A68].Find(What:=FCbl.[C7].Value, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Cel Is Nothing Then MsgBox FCbl.[C7].Value & " inexistant.", vbCritical, "Collecte": Exit Sub
Te = Cel.Offset(, 2).Resize(, 31).Value
ReDim Codes(1 To 19, 1 To 1), Périodes(1 To 19, 1 To 2)
L = 0: J = 1: CodSui = UCase(Te(1, 1))
Do ' Début code
CodCou = CodSui: Valide = DCV.Exists(CodCou)
If Valide Then L = L + 1: Codes(L, 1) = CodCou: Périodes(L, 1) = Format(Déb + J, "dd mmm yyyy")
Do: If J >= 31 Then Exit Do
J = J + 1: CodSui = UCase(Te(1, J)): Loop Until CodSui <> CodCou
' Fin code
If Valide Then Périodes(L, 2) = Format(Déb + J - 1, "dd mmm yyyy")
Loop Until J >= 31
FCbl.[A13].Resize(19, 1).Value = Codes
FCbl.[C13].Resize(19, 2).Value = Périodes
FCbl.[G35:R40].Value = ThisWorkbook.Worksheets(FCbl.[C7].Value).[C40:N45].Value
End Sub
voila.