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
| Option Explicit
Public Sub RepartitionIndicateursProjets()
Application.EnableEvents = False 'Pour ne pas que ton Worksheet_Change ne se déclenche
Dim wsSomm As Worksheet
Dim wsProjet As Worksheet
Dim iCol, iRow, newRow As Integer
Set wsSomm = Worksheets("Sommaire") 'La feuille principale
iCol = 4
'On boucle sur les colonnes des différents projets
Do While wsSomm.Cells(1, iCol).Value <> ""
'On regarde si la feuille correspondante existe, sinon on la crée
On Error Resume Next
Set wsProjet = Worksheets(wsSomm.Cells(1, iCol).Value)
If Err.Number <> 0 Then
Set wsProjet = Worksheets.Add
wsProjet.Name = wsSomm.Cells(1, iCol).Value
End If
On Error GoTo 0
'On prépare la mise ne forme
wsProjet.Cells.Clear
wsSomm.Range("A1:C1").Copy
wsProjet.Paste wsProjet.Range("A1")
'On boucle sur les lignes
iRow = 2
newRow = 2
Do While wsSomm.Cells(iRow, iCol).Value <> "" 'Tant qu'il y a une valeur
If wsSomm.Cells(iRow, iCol).Value = 1 Then 'Si on a 1 dans la colonne correspondante
'On copie la ligne
wsSomm.Range(wsSomm.Cells(iRow, "A"), wsSomm.Cells(iRow, "C")).Copy
wsProjet.Paste wsProjet.Cells(newRow, "A")
newRow = newRow + 1 'Ligne suivante dans l'onglet du projet
End If
iRow = iRow + 1 'Ligne suivante dans le sommaire
Loop
iCol = iCol + 1 'On change de colonne
Loop
Application.EnableEvents = True
End Sub |
Partager