Discussion :

[fodilt]

Bonjour à tous,

Voici mon problème. J'ai un workbook avec deux feuille :
Feuille 1: j'ai un tableau avec des noms en Colonne A ( les noms s'y trouvent plusieurs fois) et des valeurs en % en colonne G.
Feuille 2 : Un tableau avec les même noms en colonne A ( mais ceux ci ne s'y trouve qu'une seule fois) et 8 colonne (A à G)
Je voudrais parcourir une liste en feuille 1 et pour chacun des noms prendre les 8 dernières valeurs ( il peut y avoir plus que 8 ) correspondant à nom et les coller en feuille 2 sur les 8 colonnes de A à G

Voici mon code mais il ne fonctionne pas il me donne la même valeur à chaque foi :



Sub Score()
Dim Score As Double
Dim lr As Integer
Dim j As Integer
Dim id As String
Dim Rng2 As Range



Workbooks("Book2.xlsx").Worksheets("data").Activate
lr = Range("A" & Rows.Count).End(xlUp).Row
Workbooks("Book2.xlsx").Worksheets("score").Activate
DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row


Workbooks("Book2.xlsx").Worksheets("data").Activate

For Z = 1 To 8


For j = lr To 3 Step -1


id = Workbooks("Book2.xlsx").Worksheets("data").Range("G" & j).value
Score = Workbooks("Book2.xlsx").Worksheets("data").Range("L" & j).Copy

Workbooks("Book2.xlsx").Worksheets("Score").Activate

Set Rng2 = Workbooks("Book2.xlsx").Worksheets("Score").Range("A:A").Find(What:=id, LookAt:=xlWhole, MatchCase:=True)

Rng2.Offset(0, Z).PasteSpecial xlPasteValues

Next j
Next Z




End Sub


Merci d'avance pour votre aide


Fodil

[Invité]

Bonjour,

Une solution possible :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Option Explicit
 
Sub Score_2()
 
Dim ShData As Worksheet
Dim DerniereLigneData As Long
Dim LigneData As Long
Dim CompteurData As Integer
 
Dim DerniereLigneScore As Long
Dim AireScore As Range
Dim CelluleScore As Range
 
    With Worksheets("Score")
         DerniereLigneScore = .Cells(.Rows.Count, 1).End(xlUp).Row
         Set AireScore = .Range(.Cells(1, 1), .Cells(DerniereLigneScore, 1))
    End With
 
    Set ShData = Sheets("Data")
    With ShData
         DerniereLigneData = .Cells(.Rows.Count, 1).End(xlUp).Row
         For Each CelluleScore In AireScore
             CompteurData = 0
             For LigneData = DerniereLigneData To 1 Step -1
                 If CelluleScore = .Cells(LigneData, 1) Then
                    CelluleScore.Offset(0, CompteurData + 1).Value = .Cells(LigneData, 7).Value
                    CompteurData = CompteurData + 1
                    If CompteurData = 8 Then Exit For
                 End If
             Next LigneData
        Next CelluleScore
    End With
 
 
 Set AireScore = Nothing
 Set ShData = Nothing
 
End Sub

Cordialement.

[fodilt]

Bonjour,

Merci beaucoup ça fonctionne


Merci,

Fodil