recupération de données dans differentes celulle

[globulle93]

bonjour a vous,

voila j'ai un fichier excel avec des données éparpillé je voudrais récupérer des données pour les regroupé pas ligne. je vais recupérer un numéro de client une date et un montant.

Sub ServiceReport()
    ' Copy the selected range to the Report worksheet
    Dim WSD As Worksheet ' Data worksheet
    Dim WSR As Worksheet ' Report worksheet
    Dim Nextrow As Long
    Dim FinalRow As Long
    Dim i As Long

    Set WSD = Worksheets(1)
    ' Add a new worksheet to this workbook
    Set WSR = Worksheets.Add(after:=Worksheets(1))
    ' Rename the new worksheet & set up titles
    WSR.Name = "Data"
          Nextrow = 1
    ' Loop through all records on WSD
    FinalRow = WSD.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 31 To FinalRow
        If WSD.Cells(i, 1) = "Identifiant de l'établissement bénéficiaire" Then
WSD.Cells(i, 2).Copy Destination:=WSR.Cells(Nextrow, 1)
            Nextrow = Nextrow + 1
        End If
    Next i
    ' Make sure WSR is the active sheet
    WSR.Select
    
End Sub

mon probleme se situe la

WSD.Cells(i, 2).Copy Destination:=WSR.Cells(Nextrow, 1)

il faudrait que j'arrive a utilser un controle cells.ofsset pour lui dire de recup tel élément de tel celulle par rapport à ma celulle de reference.

merci de votre aide j'espères avoir été claire

 

[globulle93]

c'est bon j'ai trouvé après quelque nuit de sommeil

Sub ServiceReport()
     ' Copy the selected range to the Report worksheet
     Dim WSD As Worksheet ' Data worksheet
     Dim WSR As Worksheet ' Report worksheet
     Dim Nextrow As Long ' Next row
     Dim FinalRow As Long ' End row
     Dim i As Long ' Count
    
     Set WSD = Worksheets(1)
    
     ' Add a new worksheet to this workbook
     Set WSR = Worksheets.Add(after:=Worksheets(1))
    
     ' Rename the new worksheet
     WSR.Name = "Data"
     Nextrow = 1
    
    
     ' Loop through all records on WSD
     FinalRow = WSD.Cells(Rows.Count, 1).End(xlUp).Row
     
     For i = 31 To FinalRow
         If WSD.Cells(i, 1) = "Identifiant de l'établissement bénéficiaire" Then
    
    
             ' Copy this record to the next row on WSR
     WSD.Cells(i + 1, 3).Copy Destination:=WSR.Cells(Nextrow, 1)
    WSD.Cells(i + 1, 1).Copy Destination:=WSR.Cells(Nextrow, 2)
     
         ElseIf WSD.Cells(i, 1) = "Totaux" Then
      
      ' Copy this record to the next row on WSR
       
     WSD.Cells(i, 11).Copy Destination:=WSR.Cells(Nextrow, 3)
         
             Nextrow = Nextrow + 1
         End If
     
      Next i
    
     ' Make sure WSR is the active sheet
     WSR.Select

 
End Sub

voila si d'autre cherche une solution
par contre si vous avez des idées pour minimiser le temps de traitement je suis preneur
pour le moment un fichier de 5000 ligne met 10 s