Discussion :

[drylanda]

Bonjour à tous !
Merci d'avance pour le fait de réfléchir à ma préoccupation.
Le classeur que je m'en vais vous soumettre me permet d'analyser au quotidien l'évolution de certains stocks. Je voudrais ventiler les données qui se trouvent dans la feuille "TODAY" vers les 36 autres feuilles/onglets contenues dans le classeur. Le code VBA exploité ici agit de manière à copier entièrement une ligne de la feuille "TODAY" s'il y à correspondance entre le contenu de la cellule "B" (2è colonne) et une des 36 feuilles/onglets de ce classeur. Après quelques jours de recherche,, j'ai pu trouver un code VBA et l'ajuster à mes besoins. Ma première préoccupation est que je cherche à ce que Excel en collant les données procède à une fusion de la mise en forme conditionnelle (collage spécial/fusionner la mise ne forme conditionnelle). En L'état actuel, lorsque la commande s'exécute, la mise en forme déjà présente sur la ligne ou les données sont collées s'efface.

Merci.

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
Dim j As Integer
Dim LastRow_SOURCE As Long
Dim LastRow As Long
 
Public Sub Ventilation()
    Application.ScreenUpdating = False
 
    'on part de la source
    LastRow_TODAY = Sheets("TODAY").Range("A" & Rows.Count).End(xlUp).Row
    'on boucle dans la source
    For k = 2 To LastRow_TODAY
       'boucle permettant de lire toutes les 36 feuilles du classeur
        For j = 1 To 36
            With Sheets(j)
                'ventiler les noms de la colonne 2 dans chaque feuille si celui-ci a le meme intitulé que la feuille
                If .Name = Sheets("TODAY").Cells(k, 2).Value Then
                    LastRow = .Range("A" & Rows.Count).End(xlUp).Row
                    Sheets("TODAY").Range("A" & k).EntireRow.Copy Destination:=.Cells(Rows.Count, 1).End(xlUp)(2)
                End If
            End With
        Next j
    Next k
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub