Affectation de plusieurs macros sur un seul bouton

[nauj]

Bonjour Forum,
J'aurais besoin de vos lumières sur un sujet.
J'ai plusieurs macros qui sont chacune affectée à un bouton. Je souhaiterais pouvoir lancer toutes ces macros (il y a en 52 correspondant au nombre de semaines d'une année) avec un seul bouton.
Pour exemple, je copie 2 d'entre elles.
Merci d'avance pour votre précieuse aide.

Sub IM_S2() 'semaine 2
Dim cel As Range 'déclare la variable cel (CELlule)
Dim pl As Range 'déclare la variable pl (PLage)
Dim dest As Range 'décalre la variable dest (DESTination)
Dim x As Byte 'déclare la variable x

'définit la variable pl
With Sheets("1S09") 'prend en compte l'onglet "1S09"
Set pl = .Range("A2:A" & .Range("A65536").End(xlUp).Row) 'définit la plage pl
End With 'fin de la prise en compte de l'onglet "Feuil1"

For Each cel In pl 'boucle sur toutes les cellules éditées cel de la plage pl
For x = 14 To 18 'boucle sur semaine 2
If Cells(cel.Row, x) = "I" Then GoTo copie 'condition : si la cellule contient "I" va à la balise "copie"
Next x 'prochaine colonne de la semaine 2
GoTo suite 'va à la balise "suite" (sans copier le nom)

copie: 'balise
With Sheets("Synthèse IM") 'prend en compte l'onglet "Synthèse IM"
If .Range("A2").Value = "" Then 'condition : si A2 est vide
Set dest = .Range("A2") 'définit la variable dest (A2)
Else 'sinon
Set dest = .Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable A2 (la première ligne vide rencontrée)
End If 'fin de la condition
End With 'fin de la prise en compte de l'onglet "Synthèse IM"
cel.Copy Destination:=dest 'copie le nom et le colle

suite: 'balise
Next cel 'prochaine cellule cel de la plage pl

End Sub


Sub IM_S3() 'semaine 3
Dim cel As Range
Dim pl As Range
Dim dest As Range
Dim x As Byte

With Sheets("1S09")
Set pl = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
For Each cel In pl
For x = 19 To 23
If Cells(cel.Row, x) = "I" Then GoTo copie
Next x
GoTo suite
copie:
With Sheets("Synthèse IM")
If .Range("C2").Value = "" Then
Set dest = .Range("C2")
Else
Set dest = .Range("C65536").End(xlUp).Offset(1, 0)
End If
End With
cel.Copy Destination:=dest
suite:
Next cel
End Sub

 

[pierrejean]

Re : Affectation de plusieurs macros sur un seul bouton

bonjour nauj

A tester:

Sub IM_S() '52semaine
Dim cel As Range
Dim pl As Range
Dim dest As Range
Dim x As Byte
With Sheets("1S09")
Set pl = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
For n = 1 To 52
For Each cel In pl
For x = 9 + (n - 1) * 5 To (9 + (n - 1) * 5) + 4
If Cells(cel.Row, x) = "I" Then GoTo copie
Next x
GoTo suite
copie:
With Sheets("Synthèse IM")
If .Range("C2").Value = "" Then
Set dest = .Range("C2")
Else
Set dest = .Range("C65536").End(xlUp).Offset(1, 0)
End If
End With
cel.Copy Destination:=dest
suite:
Next cel
Next n
End Sub

 

[nauj]

Re : Affectation de plusieurs macros sur un seul bouton

Bonsoir PierreJean, Forum,
Merci pour ta réactivité, je vais tester ton code.
Une petit complément d'information. Les informations recueillies sur l'onglet "1S09" sont collées sur l'onglet "Synthèse IM" de la façon suivante :
Sem 1 sur col A
Sem 2 sur col C
Sem 3 sur col E
Est cela que l'on peut lire dans ta proposition de macro ?
Merci encore

 

[pierrejean]

Re : Affectation de plusieurs macros sur un seul bouton

Re

Je n'avais pas reperé ceci

modif a apporter

With Sheets("Synthèse IM")
If [COLOR=blue].Cells(2,2*n-1).[/COLOR]Value = "" Then
Set dest = .[COLOR=blue]Cells(2,2*n-1)[/COLOR]'Range("C2")
Else
Set dest = .[COLOR=blue]Cells(65536,2*n-1).[/COLOR]End(xlUp).Offset(1, 0)
End If
End With
cel.Copy Destination:=dest

NB: Pour nous eviter de tomber dans ce genre de panneau un fichier exemple est toujours tres utile

 

[nauj]

Re : Affectation de plusieurs macros sur un seul bouton

PierreJean, Forum,
C'est parfait à une exception près, la première colonne de destination est la A et non la C.
Quelle modification faut il y apporter sur ton dernier code ?
Je profite pour vous poser une dernière question :
Sur cet onglet "Synthèse IM", je souhaiterais que les colonnes impaires A, C, E, G, ... à partir de la ligne 4 soient "nettoyées" de leur valeur à chaque lancement de la macro (pour info, les colonnes paires ont des formules de calcul)
Merci encore de votre patience

 

[pierrejean]

Re : Affectation de plusieurs macros sur un seul bouton

Re

Toujours a tester:

Sub IM_S() '52semaine
Dim cel As Range
Dim pl As Range
Dim dest As Range
Dim x As Long
With Sheets("Synthèse IM")
  For n = 1 To 256 Step 2
   .Range(.Cells(4, n), .Cells(65536, n)).ClearContents
  Next n
End With
With Sheets("1S09")
Set pl = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
For n = 1 To 52
For Each cel In pl
For x = 9 + (n - 1) * 5 To (9 + (n - 1) * 5) + 4
If Sheets("1S09").Cells(cel.Row, x) = "I" Then GoTo copie
Next x
GoTo suite
copie:
With Sheets("Synthèse IM")
If .Cells(2, 2 * n - 1).Value = "" Then
Set dest = .Cells(2, 2 * n - 1)
Else
Set dest = .Cells(65536, 2 * n - 1).End(xlUp).Offset(1, 0)
End If
End With
cel.Copy Destination:=dest
suite:
Next cel
Next n
End Sub

 

[nauj]

Re : Affectation de plusieurs macros sur un seul bouton

Bonjour PierreJean, Forum,
J'ai testé, ça fonctionne parfaitement
Merci de votre aide précieuse.
Bon dimanche