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 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
| Option Base 1
Sub create_data()
Application.ScreenUpdating = False
Dim s As Worksheet
Dim c As Range
Dim nom() As String, var() As Variant ', MV() As Double
Dim index_row As Integer, index_column As Integer
index_column = 2
'je boucle pour chaque feuille dans mon classeur
For Each s In ThisWorkbook.Worksheets
i = 1
k = 1
'je regarde si la feuille choisie n'est pas la feuille de récapitulation des données
If s.Name <> "all data" Then
'je détermine la plage de référence avec les 500 noms
s.Activate
date_ref = Range("B1")
Range("B3").Select
Set plage = Range(Selection, Selection.End(xlDown))
ReDim nom(plage.Rows.Count)
ReDim var(plage.Rows.Count)
ReDim MV(plage.Rows.Count)
'je stocke les 500 noms et 500 valeurs dans 2 arrays en bouclant sur la plage
For Each c In plage
nom(i) = c.Value
var(i) = c.Offset(, 1)
'MV(i) = c.Offset(, 2)
i = i + 1
Next c
'je vais dans la feuille récapitulative
Sheets("All data").Activate
Cells(1, index_column + 1) = date_ref
'index row mesure le nbre de lignes et donc de titres différents, 500 au départ
index_row = Range("A2").End(xlDown).Row - 1
'index_column = index_column + 1
Row = index_row
'je boucle pour chaque valeur contenue dans l'array nom
For k = 1 To UBound(nom)
Set valeur = Cells.Find(what:=nom(k), after:=ActiveCell)
'si la valeur n'est pas trouvée dans la feuille récapitulative, je demande à créer cette valeur
If valeur Is Nothing Then
Cells(Row + 1, 1) = nom(k)
Cells(Row + 1, index_column + 1) = var(k)
Row = Row + 1
Else
'cas standard, la valeur est retranscrite
Cells.Find(what:=nom(k), after:=ActiveCell).Activate
ActiveCell.Offset(, index_column) = var(k)
End If
Next k
End If
index_column = index_column + 1
Next s
Application.ScreenUpdating = True
End Sub |
Partager