Excel 2003 VBA - Localiser date et déplacer les données pertinentes

Question

Je dois automatiser un processus qui n'est pas un événement unique, ~ 500 installations, chacune avec plus de 100 actifs qui sont tous programmés pour des dates différentes tout au long de l'année pour l'achèvement. J'ai un classeur mis en place avec ma feuille principale/source ainsi que des feuilles de 12 mois (Jan, Fév, Mars, ... Décembre). Ce dont j'ai besoin, c'est d'une sorte de code qui me permettrait de rechercher une date particulière et de l'envoyer ainsi que d'autres données correspondantes de la même ligne à la feuille appropriée.

Par exemple, j'ai un actif qui doit être réparé en juin, 17/06/11. J'ai besoin d'Excel pour le rechercher en utilisant le mois seulement, et déplacer cet actif ainsi que son nom, description, coût, etc à l'onglet Juin. Ive a réussi à l'obtenir pour localiser les actifs à la recherche de "6 /" mais il ne peut pas trouver des actifs avec une date du 17/06/11. Il copie toutes les données nécessaires et tente de le déplacer vers la feuille appropriée, quand il fait cette tentative un code d'erreur Microsoft Visual Basic 400 apparaît. Des idées? Toute aide appréciée.

Answer 1

voir si cela aide ...

Private Sub FindCells() 
    '' step 1, find all the rows containing your date (June 2011 dates hardcoded in this example) 
    Dim CollectionOfRowRanges As New Collection 
    Dim ws As Worksheet 
    Dim rgCell As Range 
    For Each ws In ThisWorkbook.Worksheets 
     For Each rgCell In ws.UsedRange.Cells 
      If IsDate(rgCell.Text) Then 
       If Month(CDate(rgCell.Value)) = 6 And Year(CDate(rgCell.Value)) = 2011 Then 
        '' for debugging only ... watch and make sure it stops at the right places 
        ws.Activate 
        rgCell.Select 
        Stop 
        '' end of debug code 
        Call CollectionOfRowRanges.Add(rgCell.EntireRow) 
       End If 
      End If 
     Next rgCell 
    Next ws 
    '' step 2, copy the rows to a new wb 
    Set ws = Workbooks.Add.Sheets(1) 
    ws.Name = "June 2011 Rows" 
    Dim rgRow As Range 
    Set rgCell = ws.Cells(1, 1) 
    For Each rgRow In CollectionOfRowRanges 
     Call rgRow.Copy 
     Call rgCell.EntireRow.PasteSpecial(xlPasteValues) 
     Set rgCell = rgCell.Offset(1) 
    Next rgRow 
End Sub