Intersection Ligne colonne et inscription dans (x) Colonnes

[Didier972]

Bonjour

Voilà mon soucis

Mon tableau sert à la gestion de stock de location.

Ma Macro se passe comme cela, (Normalement...lol)

1 - Recherche du code
2 - Inscription de la quantitée commandée
3 - Déduction du Stock
4 - Inscrit la Date de Sortie
5 - Inscrit la Date du Retour
6 - Compte le nbre de jour de sortie

Jusque là ca va ..................

Je me trouve dans la cellule nbre de jour de sortie sur une ligne (x)

A partir de là, j'aimerais rechercher la date de sortie (le calendrier commence en (M2)-ou Cells (2,12)

TheDate = CDate(C(1, 9)) '(Command.Lab_DatCde)
With Worksheets("Articles")
ActiveSheet.Cells(2, 13).Select ' Je ne sais pas si cela est bien utile ????
        Index = Application.Match(TheDate, .Range(.Cells(2, 12), .Cells(2, .Columns.Count)), 0) '
       
        If IsError(Index) Then

            MsgBox "Résultat négatif. Rien trouvé.", _
                   vbOKOnly + vbInformation, _
                   "Résultat"
        Else
           .Cells(2, Index).Select 'Sélectionne la date
        End If

Selectionner la cellule qui se trouve au croisement de ma ligne et de ma colonne, Apartir de cette cellule inscrire le stock disponible a partir de la date de sortie jusqu'à la date de retour.

'---------------------------Sélectionne la cellule à l'intersection Ligne/Colonne----------

Set Date_Loc = ActiveCell
col = Date_Loc.Column

Set Personnel = Range("B5:B1000").Find(Command.TB_Code)
ligne = Personnel.Row
Cells(ligne, col).Select
Application.ScreenUpdating = True
 
 For i = 1 To Temps
ActiveCell = CDec(C(1, 7))
ActiveCell.Offset(0, 1).Select
Next i

End With
Application.ScreenUpdating = True
Worksheets("Planning").Activate

Voilà cela fait plusieurs jours voir semaine que je bloque dessus Si quequ'un avait une idée. Merci d'avance . Je joins le code complet au cas ou.

Sub location()
Dim TheDate As Long, Index As Variant

Application.ScreenUpdating = False
Worksheets("Articles").Activate
Code = "LCHAP300" 'Code AGLM
Cde3 = "1" 'Command.TB3 'Valeur de la TB3 de l'USF Command
DatCde = CDate("04/01/13") 'Command.Lab_DatCde.Caption
DatRet = CDate("06/01/13") 'Command.Lab_DateRetour.Caption

'If Command.TB3 = "" Then
'Else
Worksheets("Articles").Activate
 
    With Sheets("Articles")
            'Chercher son nom dans la feuille Conso colonne B
            Set C = .Range("B2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row).Find( _
                            What:=Code, _
                            After:=.Range("B2"), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
    Columns(2).Find(Code, , , , , Previous).Select
            C.Value = Code
       
      
        MsgBox "Quantité commandé : " & Cde3
        
        If C(1, 8).Value = "" Then
            C(1, 8) = Cde3 'Nbre ce Chapiteaux Cdé
            C(1, 7).FormulaR1C1 = "=[@[Stock Total]]-[@[Qté Sortie]]" 'DIspo = Stock Total - Qté Sortie
        Else
            C(1, 8) = C(1, 8) + Cde3 'Qté Sortie + Cde en cours
            C(1, 7).FormulaR1C1 = "=[@[Stock Total]]-[@[Qté Sortie]]" 'DIspo = Stock Total - Qté Sortie
        End If
        
      
        If DatCde = "" Then
            Else: C(1, 9) = CDate(DatCde) ' Affiche la Date de Sortie
        End If
        
       
        If DatRet = "" Then
            Else: C(1, 10) = CDate(DatRet) ' Affiche la date Retour
        End If
  
 C(1, 11).Select
 ActiveCell.FormulaR1C1 = _
        "=IF([@[Date de Retour]]="""","""",[@[Date de Retour]]-[@[Date de Sortie]])" ' Nbre de Jour de Loc = Date de Sortie - Date de Retour
  Temps = C(1, 11)
  
'Recherche Date du début


End With
TheDate = CDate(C(1, 9)) '(Command.Lab_DatCde)
With Worksheets("Articles")
ActiveSheet.Cells(2, 13).Select ' Je ne sais pas si cela est bien utile ????
        Index = Application.Match(TheDate, .Range(.Cells(2, 12), .Cells(2, .Columns.Count)), 0) '
       
        If IsError(Index) Then

            MsgBox "Résultat négatif. Rien trouvé.", _
                   vbOKOnly + vbInformation, _
                   "Résultat"
        Else
           .Cells(2, Index).Select 'Sélectionne la date
        End If
       
       
'Fin Call Croisement
'------------------Recherche la Date du Jour----------------

'---------------------------Sélectionne la cellule à l'intersection Ligne/Colonne----------

Set Date_Loc = ActiveCell
col = Date_Loc.Column

Set Personnel = Range("B5:B1000").Find(Command.TB_Code)
ligne = Personnel.Row
Cells(ligne, col).Select
Application.ScreenUpdating = True
 
 For i = 1 To Temps
ActiveCell = CDec(C(1, 7))
ActiveCell.Offset(0, 1).Select
Next i

End With
Application.ScreenUpdating = True
Worksheets("Planning").Activate
'End If
End Sub

 

[Didier972]

Re : Intersection Ligne colonne et inscription dans (x) Colonnes

J'ai trouvé le problème, la macro était bonne, c'est la mise en forme de ma feuil qui n'allait pas.Merci quand même à ceux qui ce sont intéressé à mon problème.

Didier