lancement macro x fois

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
S

sergio5862

XLDnaute Nouveau
Bonsoir a tous ou bonjour pour certains

J'ai un fichier qui represente des syntheses de puissance .Sur l'onglet résulat ,un bouton lance une USF avec choix multiple .
Je voudrai lancer toutes les procédures en cochant "tous les batiments" et effectuer la mise a jour de tous mes onglets .( pour l'instant la coche enabled est a false)
je joins le fichier sur ci-joint.fr

Cijoint.fr - Service gratuit de dépôt de fichiers
Cordialement
sergio
 
Trier par date Trier par votes
Re : lancement macro x fois

Bonjour le forum,

je n'arrive toujours pas a declencher si je coche "tous les batiments" la mise a jour des recherches sur chaques onglets.Je ne sais ou insérer dans la procédure principale de USF ,le lancement en cascade des macros.A chaque fois ,elle s'arrete apres la mise jour de l'onglet "Batiment A".Merci ,de bien vouloir de me donner une piste et me dire si c'est possible de le faire.
Cette macro doit se declencher tous les jours vers 06:00 par le plannificateur de taches et je suis bloquer pour l'automatiser.
Cordialement,
sergio
 
Vote positif 0 Vote négatif
Re : lancement macro x fois

sergio5862 à dit:
Bonjour le forum,

je n'arrive toujours pas a declencher si je coche "tous les batiments" la mise a jour des recherches sur chaques onglets.Je ne sais ou insérer dans la procédure principale de USF ,le lancement en cascade des macros.A chaque fois ,elle s'arrete apres la mise jour de l'onglet "Batiment A".Merci ,de bien vouloir de me donner une piste et me dire si c'est possible de le faire.
Cette macro doit se declencher tous les jours vers 06:00 par le plannificateur de taches et je suis bloquer pour l'automatiser.
Cordialement,
Cliquez pour agrandir...

Merci pour d'avoir pris le temps de me lire ,ci dessous le code qui n'est peut être pas parfait mais il fonctionne.Merci aux personnes qui ont développé les bouts de macros que j'ai adapté a mon fichier.

Si vous avez une idée pour le simplifier ,voir l'optimiser .merci
Serge

Sub recherche_batiments()

Dim choix
Dim Batiment As String
Dim lig As Long, w As Worksheet, cel As Range, part As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Demasquer_feuillles
Load infobox
infobox.Show vbModeless
Sheets("résultat").Select
Sheets("résultat").Rows("3:65536").ClearContents
TextBox1 = "batiment A"
If TextBox1 = "" Then GoTo 1
lig = 2
part = IIf(CheckBox2, "*", "")
For Each w In Worksheets

infobox.Label1.Caption = "Recherche des Puissances Mini pour le " & TextBox1
infobox.Repaint
If w.Name <> "résultat" And w.Name <> "batiment A" And w.Name <> "batiment B" And w.Name <> "batiment C" And w.Name <> "batiment V" And w.Name <> "batiment H" And w.Name <> "batiment Montage" And w.Name <> "batiment L" And w.Name <> "batiment F" And w.Name <> "batiment G" And w.Name <> "batiment K1" Then
For Each cel In w.[A3:I3]
If IIf(CheckBox1, cel Like part & TextBox1 & part, UCase(cel) Like part & UCase(TextBox1) & part) Then
lig = lig + 1
Sheets("résultat").Cells(lig, 1) = w.Name
Sheets("résultat").Cells(lig, 2).Resize(, 10) = w.Cells(cel.Row, 1).Resize(, 10).Value 'copie sur 10 colonnes
End If
Sheets("résultat").Select
Batiment = TextBox1
Cells.Select
Selection.Copy
Sheets(Batiment).Select
Range("A1").Select
ActiveSheet.Paste

Next cel
End If

Next w
Sheets("résultat").Select
Sheets("résultat").Rows("3:65536").ClearContents
TextBox1 = "batiment B"

UserForm1.Repaint
If TextBox1 = "" Then GoTo 1
lig = 2
part = IIf(CheckBox2, "*", "")
For Each w In Worksheets

infobox.Label1.Caption = "Recherche des Puissances Mini pour le " & TextBox1 & " BB2 - B2 "
infobox.Repaint
If w.Name <> "résultat" And w.Name <> "batiment A" And w.Name <> "batiment B" And w.Name <> "batiment C" And w.Name <> "batiment V" And w.Name <> "batiment H" And w.Name <> "batiment Montage" And w.Name <> "batiment L" And w.Name <> "batiment F" And w.Name <> "batiment G" And w.Name <> "batiment K1" Then
For Each cel In w.[A4:I6]
If IIf(CheckBox1, cel Like part & TextBox1 & part, UCase(cel) Like part & UCase(TextBox1) & part) Then
lig = lig + 1
Sheets("résultat").Cells(lig, 1) = w.Name
Sheets("résultat").Cells(lig, 2).Resize(, 10) = w.Cells(cel.Row, 1).Resize(, 10).Value
End If
Sheets("résultat").Select
Batiment = TextBox1
Cells.Select
Selection.Copy
Sheets(Batiment).Select
Range("A1").Select
ActiveSheet.Paste

Next cel
End If

Next w

Sheets("résultat").Select
Sheets("résultat").Rows("3:65536").ClearContents
TextBox1 = "batiment C"
UserForm1.Repaint
If TextBox1 = "" Then GoTo 1
lig = 2
part = IIf(CheckBox2, "*", "")
For Each w In Worksheets

infobox.Label1.Caption = "Recherche des Puissances Mini pour le " & TextBox1
infobox.Repaint
If w.Name <> "résultat" And w.Name <> "batiment A" And w.Name <> "batiment B" And w.Name <> "batiment C" And w.Name <> "batiment V" And w.Name <> "batiment H" And w.Name <> "batiment Montage" And w.Name <> "batiment L" And w.Name <> "batiment F" And w.Name <> "batiment G" And w.Name <> "batiment K1" Then
For Each cel In w.[A7:I7]
If IIf(CheckBox1, cel Like part & TextBox1 & part, UCase(cel) Like part & UCase(TextBox1) & part) Then
lig = lig + 1
Sheets("résultat").Cells(lig, 1) = w.Name
Sheets("résultat").Cells(lig, 2).Resize(, 10) = w.Cells(cel.Row, 1).Resize(, 10).Value
End If
Sheets("résultat").Select
Batiment = TextBox1
Cells.Select
Selection.Copy
Sheets(Batiment).Select
Range("A1").Select
ActiveSheet.Paste

Next cel
End If

Next w


Sheets("résultat").Select
Sheets("résultat").Rows("3:65536").ClearContents
TextBox1 = "batiment V"
UserForm1.Repaint
If TextBox1 = "" Then GoTo 1
lig = 2
part = IIf(CheckBox2, "*", "")
For Each w In Worksheets

infobox.Label1.Caption = "Recherche des Puissances Mini pour le " & TextBox1
infobox.Repaint
If w.Name <> "résultat" And w.Name <> "batiment A" And w.Name <> "batiment B" And w.Name <> "batiment C" And w.Name <> "batiment V" And w.Name <> "batiment H" And w.Name <> "batiment Montage" And w.Name <> "batiment L" And w.Name <> "batiment F" And w.Name <> "batiment G" And w.Name <> "batiment K1" Then
For Each cel In w.[A8:I8]
If IIf(CheckBox1, cel Like part & TextBox1 & part, UCase(cel) Like part & UCase(TextBox1) & part) Then
lig = lig + 1
Sheets("résultat").Cells(lig, 1) = w.Name
Sheets("résultat").Cells(lig, 2).Resize(, 10) = w.Cells(cel.Row, 1).Resize(, 10).Value 'copie sur 20 colonnes
End If
Sheets("résultat").Select
Batiment = TextBox1
Cells.Select
Selection.Copy
Sheets(Batiment).Select
Range("A1").Select
ActiveSheet.Paste

Next cel
End If

Next w



Sheets("résultat").Select
Sheets("résultat").Rows("3:65536").ClearContents
TextBox1 = "batiment H"
UserForm1.Repaint
If TextBox1 = "" Then GoTo 1
lig = 2
part = IIf(CheckBox2, "*", "")
For Each w In Worksheets

infobox.Label1.Caption = "Recherche des Puissances Mini pour le " & TextBox1
infobox.Repaint
If w.Name <> "résultat" And w.Name <> "batiment A" And w.Name <> "batiment B" And w.Name <> "batiment C" And w.Name <> "batiment V" And w.Name <> "batiment H" And w.Name <> "batiment Montage" And w.Name <> "batiment L" And w.Name <> "batiment F" And w.Name <> "batiment G" And w.Name <> "batiment K1" Then
For Each cel In w.[A9:I9]
If IIf(CheckBox1, cel Like part & TextBox1 & part, UCase(cel) Like part & UCase(TextBox1) & part) Then
lig = lig + 1
Sheets("résultat").Cells(lig, 1) = w.Name
Sheets("résultat").Cells(lig, 2).Resize(, 10) = w.Cells(cel.Row, 1).Resize(, 10).Value
End If
Sheets("résultat").Select
Batiment = TextBox1
Cells.Select
Selection.Copy
Sheets(Batiment).Select
Range("A1").Select
ActiveSheet.Paste

Next cel
End If

Next w

Sheets("résultat").Select
Sheets("résultat").Rows("3:65536").ClearContents
TextBox1 = "batiment MONTAGE"
UserForm1.Repaint
If TextBox1 = "" Then GoTo 1
lig = 2
part = IIf(CheckBox2, "*", "")
For Each w In Worksheets

infobox.Label1.Caption = "Recherche des Puissances Mini pour le " & TextBox1
infobox.Repaint
If w.Name <> "résultat" And w.Name <> "batiment A" And w.Name <> "batiment B" And w.Name <> "batiment C" And w.Name <> "batiment V" And w.Name <> "batiment H" And w.Name <> "batiment Montage" And w.Name <> "batiment L" And w.Name <> "batiment F" And w.Name <> "batiment G" And w.Name <> "batiment K1" Then
For Each cel In w.[A10:I10]
If IIf(CheckBox1, cel Like part & TextBox1 & part, UCase(cel) Like part & UCase(TextBox1) & part) Then
lig = lig + 1
Sheets("résultat").Cells(lig, 1) = w.Name
Sheets("résultat").Cells(lig, 2).Resize(, 10) = w.Cells(cel.Row, 1).Resize(, 10).Value
End If
Sheets("résultat").Select
Batiment = TextBox1
Cells.Select
Selection.Copy
Sheets(Batiment).Select
Range("A1").Select
ActiveSheet.Paste

Next cel
End If

Next w

Sheets("résultat").Select
Sheets("résultat").Rows("3:65536").ClearContents
TextBox1 = "batiment K1"
UserForm1.Repaint
If TextBox1 = "" Then GoTo 1
lig = 2
part = IIf(CheckBox2, "*", "")
For Each w In Worksheets

infobox.Label1.Caption = "Recherche des Puissances Mini pour le " & TextBox1
infobox.Repaint
If w.Name <> "résultat" And w.Name <> "batiment A" And w.Name <> "batiment B" And w.Name <> "batiment C" And w.Name <> "batiment V" And w.Name <> "batiment H" And w.Name <> "batiment Montage" And w.Name <> "batiment L" And w.Name <> "batiment F" And w.Name <> "batiment G" And w.Name <> "batiment K1" Then
For Each cel In w.[A11:I11]
If IIf(CheckBox1, cel Like part & TextBox1 & part, UCase(cel) Like part & UCase(TextBox1) & part) Then
lig = lig + 1
Sheets("résultat").Cells(lig, 1) = w.Name
Sheets("résultat").Cells(lig, 2).Resize(, 10) = w.Cells(cel.Row, 1).Resize(, 10).Value
End If
Sheets("résultat").Select
Batiment = TextBox1
Cells.Select
Selection.Copy
Sheets(Batiment).Select
Range("A1").Select
ActiveSheet.Paste

Next cel
End If

Next w


Sheets("résultat").Select
Sheets("résultat").Rows("3:65536").ClearContents
TextBox1 = "batiment DIVERS"
UserForm1.Repaint
If TextBox1 = "" Then GoTo 1
lig = 2
part = IIf(CheckBox2, "*", "")
For Each w In Worksheets

infobox.Label1.Caption = "Recherche des Puissances Mini pour le " & TextBox1
infobox.Repaint
If w.Name <> "résultat" And w.Name <> "batiment A" And w.Name <> "batiment B" And w.Name <> "batiment C" And w.Name <> "batiment V" And w.Name <> "batiment H" And w.Name <> "batiment Montage" And w.Name <> "batiment L" And w.Name <> "batiment F" And w.Name <> "batiment G" And w.Name <> "batiment K1" Then
For Each cel In w.[A12:I12]
If IIf(CheckBox1, cel Like part & TextBox1 & part, UCase(cel) Like part & UCase(TextBox1) & part) Then
lig = lig + 1
Sheets("résultat").Cells(lig, 1) = w.Name
Sheets("résultat").Cells(lig, 2).Resize(, 10) = w.Cells(cel.Row, 1).Resize(, 10).Value
End If
Sheets("résultat").Select
Batiment = TextBox1
Cells.Select
Selection.Copy
Sheets(Batiment).Select
Range("A1").Select
ActiveSheet.Paste

Next cel
End If

Next w

Sheets("résultat").Select
Sheets("résultat").Rows("3:65536").ClearContents
TextBox1 = "batiment L"
UserForm1.Repaint
If TextBox1 = "" Then GoTo 1
lig = 2
part = IIf(CheckBox2, "*", "")
For Each w In Worksheets

infobox.Label1.Caption = "Recherche des Puissances Mini pour le " & TextBox1
infobox.Repaint
If w.Name <> "résultat" And w.Name <> "batiment A" And w.Name <> "batiment B" And w.Name <> "batiment C" And w.Name <> "batiment V" And w.Name <> "batiment H" And w.Name <> "batiment Montage" And w.Name <> "batiment L" And w.Name <> "batiment F" And w.Name <> "batiment G" And w.Name <> "batiment K1" Then
For Each cel In w.[A13:I13]
If IIf(CheckBox1, cel Like part & TextBox1 & part, UCase(cel) Like part & UCase(TextBox1) & part) Then
lig = lig + 1
Sheets("résultat").Cells(lig, 1) = w.Name
Sheets("résultat").Cells(lig, 2).Resize(, 10) = w.Cells(cel.Row, 1).Resize(, 10).Value
End If
Sheets("résultat").Select
Batiment = TextBox1
Cells.Select
Selection.Copy
Sheets(Batiment).Select
Range("A1").Select
ActiveSheet.Paste

Next cel
End If

Next w

Sheets("résultat").Select
Sheets("résultat").Rows("3:65536").ClearContents
TextBox1 = "batiment F"
UserForm1.Repaint
If TextBox1 = "" Then GoTo 1
lig = 2
part = IIf(CheckBox2, "*", "")
For Each w In Worksheets

infobox.Label1.Caption = "Recherche des Puissances Mini pour le " & TextBox1
infobox.Repaint
If w.Name <> "résultat" And w.Name <> "batiment A" And w.Name <> "batiment B" And w.Name <> "batiment C" And w.Name <> "batiment V" And w.Name <> "batiment H" And w.Name <> "batiment Montage" And w.Name <> "batiment L" And w.Name <> "batiment F" And w.Name <> "batiment G" And w.Name <> "batiment K1" Then
For Each cel In w.[A14:I14]
If IIf(CheckBox1, cel Like part & TextBox1 & part, UCase(cel) Like part & UCase(TextBox1) & part) Then
lig = lig + 1
Sheets("résultat").Cells(lig, 1) = w.Name
Sheets("résultat").Cells(lig, 2).Resize(, 10) = w.Cells(cel.Row, 1).Resize(, 10).Value
End If
Sheets("résultat").Select
Batiment = TextBox1
Cells.Select
Selection.Copy
Sheets(Batiment).Select
Range("A1").Select
ActiveSheet.Paste

Next cel
End If

Next w

Sheets("résultat").Select
Sheets("résultat").Rows("3:65536").ClearContents
TextBox1 = "batiment G"
UserForm1.Repaint
If TextBox1 = "" Then GoTo 1
lig = 2
part = IIf(CheckBox2, "*", "")
For Each w In Worksheets

infobox.Label1.Caption = "Recherche des Puissances Mini pour le " & TextBox1
infobox.Repaint
If w.Name <> "résultat" And w.Name <> "batiment A" And w.Name <> "batiment B" And w.Name <> "batiment C" And w.Name <> "batiment V" And w.Name <> "batiment H" And w.Name <> "batiment Montage" And w.Name <> "batiment L" And w.Name <> "batiment F" And w.Name <> "batiment G" And w.Name <> "batiment K1" Then
For Each cel In w.[A15:I15]
If IIf(CheckBox1, cel Like part & TextBox1 & part, UCase(cel) Like part & UCase(TextBox1) & part) Then
lig = lig + 1
Sheets("résultat").Cells(lig, 1) = w.Name
Sheets("résultat").Cells(lig, 2).Resize(, 10) = w.Cells(cel.Row, 1).Resize(, 10).Value
End If
Sheets("résultat").Select
Batiment = TextBox1
Cells.Select
Selection.Copy
Sheets(Batiment).Select
Range("A1").Select
ActiveSheet.Paste

Next cel
End If

Next w

infobox.Hide
Unload infobox
1 TextBox1 = "Batiment A"
masquer_feuillles
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour