Bonjour
J'aurais besoin de votre aide pour améliorer ma macro.
J'ai effectué une macro mais mon soucis est qu'elle scratch les formules de ma ligne 30 de ma feuille ( qui concatène les cellules de chaque colonne).
Voici ma macro:
Auriez vous une solution pour que ma formule reste sur ma ligne ou pour intégrer dans ma macro le concaténer en cellule 30 sur les colonnes de G à DY?
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 Sub archi_tx_de_service() Sheets("Ref").Activate Application.ScreenUpdating = False 'netoyer à partir de la colonne G Range("G1:DY29").Select Selection.ClearContents 'Recherche liste des article sans doublons dans la colonne B Dim cel As Range Dim unique As New Collection Dim i As Integer On Error Resume Next For Each cel In Range("B2:B" & [B65000].End(xlUp).Row) If cel.Value <> "" Then unique.Add cel.Value, CStr(cel.Value) End If Next cel On Error GoTo 0 'Remplir les titres des colonnes j = 7 For i = 1 To unique.Count Cells(1, j) = unique(i) j = j + 1 Next i 'Recherche données pour chaque colonne Dim plage As Range Set plage = Range("B2:B" & [B65000].End(xlUp).Row) G = 7 l = 2 For G = 7 To G + unique.Count For Each cel In plage If cel.Value <> "" And cel.Value = Cells(1, G) Then Cells(l, G) = Cells(cel.Row, 3) l = l + 1 End If Next cel Next G Application.ScreenUpdating = True Dim rng As Range, Cell As Range Set rng = Range("G1:Dy29") For Each Cell In rng If Cell.Value = "" Then Cell.SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp) End If Next
Merci pour votre aide
Partager