AJustement Array suivant nombre de colonnes
Bonjour,
Avec le code suivant (fait par Mercatog, que je remercie) je récupère des données sur une feuille pour effectuer des calculs.
On me demande de rajouter une autre feuille pour d'autres calculs. J'ai pu adapté ce code pour la 2ème feuille, mais je me retrouve avec 2 macros presque identiques. Sauf pour le nombre de colonnes sur les 2 feuilles de destination (sur feuille "Calcul" 13 colonnes et Feuille "Densité" 9 colonnes).
J'ai eu beau retourné le problème pour n'en faire qu'une seule macro rien n'y fait. J'ai pensé mettre le nom des feuilles dans un tableau variable [temp("Calcul","Densité"] et le nombre de valeurs de la ligne 9 contenant les entêtes dans une autre variable. Mais je n'ai pas su trouvé la solution.
Code:
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
| Sub Traitement()
Dim LastLig As Long, i As Long, j As Long
Dim Dte As Long, Val4 As String, Val5 As String
Dim Tb, Res()
Dim k As Byte
Application.ScreenUpdating = False
With Worksheets("BD")
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
Tb = .Range("A2:W" & LastLig)
End With
With Worksheets("Calcul")
Dte = CLng(.Range("B1"))
Val4 = .Range("F1")
Val5 = .Range("J1")
For i = 1 To LastLig - 1
If CLng(Tb(i, 3)) = Dte And Tb(i, 4) = Val4 And Tb(i, 5) = Val5 Then
j = j + 1
ReDim Preserve Res(1 To 12, 1 To j)
Res(1, j) = j
Res(2, j) = Tb(i, 7)
Res(3, j) = Tb(i, 8)
Res(4, j) = Tb(i, 9)
Res(5, j) = Tb(i, 10)
Res(10, j) = Tb(i, 15)
Res(11, j) = Tb(i, 16)
End If
Next i
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
If LastLig > 10 Then .Range("A10:L" & LastLig).Clear
If j > 0 Then .Range("A10").Resize(j, 12) = Application.Transpose(Res)
End With
End Sub |
Je vous remercie beaucoup pour votre aide.
Cordialement
