Hello

J'ai écrit une fonction qui copie des données d'une feuille à une autre. Dans la première feuille j'ai 3 colonnes de 3 règles différentes (Completness, Accuracy, Validity) mais dans la deuxième feuille je veux collecter ces règles dans une seule colonne et mettre le type de chaque règle devant (voir photo, la feuille SOURCE c'est ce que j'ai et la feuille COPY c'est ce que je veux avoir)

Nom : PH1.PNG
Affichages : 103
Taille : 23,7 Ko
Nom : PH2.PNG
Affichages : 106
Taille : 25,8 Ko

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
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
Function columnLookup(Name As String, Line As Range) As Integer
Dim i As Integer
Dim Cell As Range
 
i = 0
For Each Cell In Line
    If Cell.Value = Name Then
        i = Cell.Column
    End If
Next Cell
 
columnLookup = i
End Function
 
Sub CopyfromSource()
 
 
    Dim k As Variant
    Dim localworksheet, globalWorksheet As String
    Dim currentLine, currentLine1 As Integer
    Dim classeur As Workbook
 
    Dim nameFile As String
 
 
    Dim headerSource As Range
    Dim headerCopy As Range
 
    Dim attributSource, attributCopy As Integer
 
 
    globalWorksheet = "Source"
    localworksheet = "Copy"
 
 
    Worksheets(globalWorksheet).Activate
 
    Set headerSource = Worksheets(globalWorksheet).Range("A1", Worksheets(globalWorksheet).Range("A1").End(xlToRight))
    Set headerCopy = Worksheets(localworksheet).Range("A1", Worksheets(localworksheet).Range("A1").End(xlToRight))
 
 
    attributSource = columnLookup("Attribute", headerSource)
    attributCopy = columnLookup("Attribute", headerCopy)
 
 
    'Copy
 
    currentLine1 = 2
 
    For k = 2 To 10
 
 
        Worksheets(localworksheet).Cells(currentLine1, attributCopy).Value = Worksheets(globalWorksheet).Cells(k, attributSource).Value
 
        currentLine1 = currentLine1 + 1
 
    Next k
 
 
    Worksheets(localworksheet).Activate
 
 
    ActiveSheet.Copy
 
 
End Sub