Discussion :

[dmalfi]

Bonjour a tous,

je suis complètement néophyte et je vous envie souvent quand je suis la résolution des problèmes de chacun sur leur code VBA.
Allez je me lance et je demande votre aide.

Voici mon souci:

J'extraie des données d'une base de données. (onglet extraction brute)
Ces données sont a envoyer dans une feuille de restitution (onglet Feuille à alimenter)

dans extraction brute, mes données se présentent en ligne.
de RespId (A1) à Q4a_10 (IH1) puis de Q1b_01_01 (IK1) à Q4a3_10 (RP1) - ce sont les données a déplacer

Je dois les restituer dans la feuille à alimenter comme ceci

Le Respid doit se répéter 20 fois dans les 20 premières lignes
Le Nom doit aller 20 fois dans les 20 mêmes lignes en dernière colonne du fichier
les données suivantes sont à séparer toutes les 21 colonnes de l'extraction brute et a reporter dans a restituer comme ceci
exemple:
de Q1a_01_01 à Q1a_01_21 va en P2 (CLST - sniff___SH1_1) jusqu'en AJ2 (CLST - sniff___SH1_21)
et ainsi de suite Q2a_01_01 à Q2a_01_21 va en P3 jusqu'en AJ3
jusqu'a AJ10
pour la deuxième partie idem
de Q1b_01_01 à Q1b_01_21 va en P12 Jusqu'en AJ12

Puis
Q2a_01 va en AK2
Q2a_02 va en AK3
Q2a_03 va en AK4
Ect.... jusqu'à Q2a_10 va en AK11

Puis

Q2b_01 va en AK12
Q2b_02 va en AK13
Q2a_03 va en AK14
Ect.... jusqu'à Q2b_10 va en AK21

Idem pour

Q3a_01 jusqu'a Q3a_10
Q3b_11 jusqu'a Q3b_20
et pour

Q4a_01 jusqu'à Q4a_10
Q4a_11 jusqu'à Q4a_20

et voilà.... ouf, je ne sais pas si je suis claire....
je joint en pièce jointe le fichier

il faudrait aussi que feuille a restituer soit réinitialiser avant chaque exécution (sauf pour les colonne de B à L - données fixes - et les colonnes M,N et O)
et que je puisse l'utiliser plusieurs fois
pour l'instant je n'ai que 135 id mais je pourrais en avoir plus
idem pour le nombre de proposition (21)
j'espère que vous pourrez faire quelque chose pour moi
merci d'avance de vos lumières

[dmalfi]

bonsoir àTous,
Pour faire suite au premier message posté vendredi
voici ce que j'ai réussi a faire en adaptant un autre code que j'avais sur une précédente feuille.
mais le problème c'est que cela marche sur les 4 premières lignes mais tout le reste est décalé...
quelqu'un aurait_il la gentillesse de regarder et de m'expliquer ce qu'il ne vas pas? merci
la feuille xls est dans le premier message

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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
Sub Macro1()
'
' Macro1 Macro
'
 
'
 
Dim table_item(1 To 21) As Integer
Dim id_col As Long
Dim id_ligne As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim p As Long
Dim nb_ligne_plus As Long
Dim table_alim(1 To 21) As Long
Dim nom_user As String
 
'========================================================
' Alimentation de la table de correspondance
table_item(1) = 9
table_item(2) = 18
table_item(3) = 17
table_item(4) = 15
table_item(5) = 4
table_item(6) = 16
table_item(7) = 13
table_item(8) = 12
table_item(9) = 6
table_item(10) = 10
table_item(11) = 1
table_item(12) = 8
table_item(13) = 14
table_item(14) = 5
table_item(15) = 19
table_item(16) = 20
table_item(17) = 2
table_item(18) = 3
table_item(19) = 7
table_item(20) = 11
table_item(21) = 21
 
 
 
'========================================================
' remise ˆ blanc de l'alimentation
Sheets("Prepa-extrac Scent Hunter").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A2:A1048575").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("P2").Select
Range(Selection, Selection.End(xlDown)).Select
Range("P2:AZ1048576").Select
Selection.ClearContents
 
'========================================================
' Positionnement sur feuille et case
Sheets("Extraction Brute").Select
Range("D2").Select
 
'========================================================
' RŽcupŽration case origine
id_ligne = ActiveCell.Row
id_col = ActiveCell.Column
k = 1
Do While Cells(id_ligne, id_col).Value <> ""
 
    '====================================================
    ' Vidage table_alim
    i = 1
    Do While i <= 21
        table_alim(i) = 0
        i = i + 1
    Loop
 
    '====================================================
    ' RŽcupŽration du mec qui rŽpond
    id_util = Cells(id_ligne, id_col - 3).Value
    nom_user = Cells(id_ligne, id_col - 2).Value
 
    '====================================================
    ' Traitement des 10 premiers produits
 
    ' i pour item
    i = 1
    'p pour produit
    p = 1
    Do While p <= 10
 
        '====================================================
        ' Vidage table_alim
        i = 1
        Do While i <= 21
            table_alim(i) = 0
            i = i + 1
        Loop
 
        '====================================================
        ' RŽcupŽration des donnŽes
        i = 1
        j = 21 * (p - 1)
        Do While i <= 21
            table_alim(table_item(i)) = Cells(ActiveCell.Row, ActiveCell.Column + ((i + j) - 1))
            i = i + 1
        Loop
 
 
        ' Alimentation des donnŽes sur pages restitution
        i = 1
        nb_ligne_plus = (20 * (k - 1))
        Sheets("Prepa-extrac Scent Hunter").Cells((2 + nb_ligne_plus) + (p - 1), 1).Value = id_util
        Do While i <= 21
            Sheets("Prepa-extrac Scent Hunter").Cells((2 + nb_ligne_plus) + (p - 1), 16 + (i - 1)).Value = table_alim(i)
 
            i = i + 1
        Loop
 
        ' Traitement des questions
        Sheets("Prepa-extrac Scent Hunter").Cells((2 + nb_ligne_plus) + (p - 1), 37).Value = Cells(ActiveCell.Row, ActiveCell.Column + (213 + (p - 1)))
        Sheets("Prepa-extrac Scent Hunter").Cells((2 + nb_ligne_plus) + (p - 1), 38).Value = Cells(ActiveCell.Row, ActiveCell.Column + (223 + (p - 1)))
        Sheets("Prepa-extrac Scent Hunter").Cells((2 + nb_ligne_plus) + (p - 1), 39).Value = Cells(ActiveCell.Row, ActiveCell.Column + (233 + (p) - 1))
        Sheets("Prepa-extrac Scent Hunter").Cells((2 + nb_ligne_plus) + (p - 1), 40).Value = nom_user
 
        ' On passe au produit suivant
        p = p + 1
    Loop
 
 
    '====================================================
    ' Traitement des 10 dernier produits
 
    ' i pour item
    i = 1
    'p pour produit
    p = 1
    Do While p <= 10
 
        '====================================================
        ' Vidage table_alim
        i = 1
        Do While i <= 21
            table_alim(i) = 0
            i = i + 1
        Loop
 
        '====================================================
        ' RŽcupŽration des donnŽes
        i = 1
        j = 21 * (p - 1)
        Do While i <= 21
            table_alim(table_item(i)) = Cells(ActiveCell.Row, ActiveCell.Column + ((i + j) - 1) + 245)
            i = i + 1
        Loop
 
 
        ' Aliementation des donnŽes sur pages restitution
        i = 1
        nb_ligne_plus = (20 * (k - 1))
        Sheets("Prepa-extrac Scent Hunter").Cells((2 + nb_ligne_plus) + ((p + 10) - 1), 1).Value = id_util
        Do While i <= 21
            Sheets("Prepa-extrac Scent Hunter").Cells((2 + nb_ligne_plus) + ((p + 10) - 1), 16 + (i - 1)).Value = table_alim(i)
            i = i + 1
        Loop
 
 
        ' Traitement des questions
        Sheets("Prepa-extrac Scent Hunter").Cells((2 + nb_ligne_plus) + ((p + 10) - 1), 37).Value = Cells(ActiveCell.Row, ActiveCell.Column + (455 + (p - 1)))
        Sheets("Prepa-extrac Scent Hunter").Cells((2 + nb_ligne_plus) + ((p + 10) - 1), 38).Value = Cells(ActiveCell.Row, ActiveCell.Column + (465 + (p - 1)))
        Sheets("Prepa-extrac Scent Hunter").Cells((2 + nb_ligne_plus) + ((p + 10) - 1), 39).Value = Cells(ActiveCell.Row, ActiveCell.Column + (475 + (p) - 1))
        Sheets("Prepa-extrac Scent Hunter").Cells((2 + nb_ligne_plus) + ((p + 10) - 1), 40).Value = nom_user
 
 
        ' On passe au produit suivant
        p = p + 1
    Loop
 
    k = k + 1
    id_ligne = id_ligne + 1
    Cells(id_ligne, id_col).Select
Loop
 
 
End Sub