exécuter 2 macros en même temps

[archi]

Bjr,

j'aimerai exécuter 2 macros (ci-joint) par une seule commande
que dois-je faire ???

éventuellement l'idéal serait de faire une compilation (2 en 1)(les variables sont en rouge)
merci
bye

-----------------------------------
Sub Equipe_100()
Application.ScreenUpdating = False
With Sheets('Equipe 1').Range('C2')
If InStr(1, .Value, ' ') < 1 Then Exit Sub
Nom = Left(.Value, InStr(1, .Value, ' ') + 1) + '.'
Nom = Application.WorksheetFunction.Proper(Nom)
End With
With Sheets(Nom)
Lig1 = .Range('A10000').End(xlUp).Row
Range(.Range('H' & Lig1 + 1), .Range('H' & Lig1 + 3)).Clear
End With
With Sheets('Equipe 1')
i = Application.CountA(.Range('D58'))
.Range('B5:I' & 4 + i).Copy
End With
With Sheets(Nom)
.Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
.Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Range(.Range('A4'), .Range('H' & Lig1)).Validation.Delete
Lig1 = .Range('A65536').End(xlUp).Row
Lig2 = .Range('J65536').End(xlUp).Row + 1
.Range('A4:H' & Lig1).Validation.Delete
Range(.Range('A4'), .Range('H' & Lig1)).Sort Key1:=.Range('A4'), Order1:=xlAscending
Range(.Range('J' & Lig2 - 1), .Range('M' & Lig2 - 1)).AutoFill _
Destination:=Range(.Range('J' & Lig2 - 1), .Range('M' & Lig1)), Type:=xlFillDefault
End With
Sheets('Equipe 1').Activate: Range('C2').Select
Application.ScreenUpdating = True
End Sub
-------------------------------------
Sub Equipe_101()
Application.ScreenUpdating = False
With Sheets('Equipe 1').Range('C9')
If InStr(1, .Value, ' ') < 1 Then Exit Sub
Nom = Left(.Value, InStr(1, .Value, ' ') + 1) + '.'
Nom = Application.WorksheetFunction.Proper(Nom)
End With
With Sheets(Nom)
Lig1 = .Range('A10000').End(xlUp).Row
Range(.Range('H' & Lig1 + 1), .Range('H' & Lig1 + 3)).Clear
End With
With Sheets('Equipe 1')
i = Application.CountA(.Range('D1214'))
.Range('B12:I' & 11 + i).Copy
End With
With Sheets(Nom)
.Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
.Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Range(.Range('A4'), .Range('H' & Lig1)).Validation.Delete
Lig1 = .Range('A65536').End(xlUp).Row
Lig2 = .Range('J65536').End(xlUp).Row + 1
.Range('A4:H' & Lig1).Validation.Delete
Range(.Range('A4'), .Range('H' & Lig1)).Sort Key1:=.Range('A4'), Order1:=xlAscending
Range(.Range('J' & Lig2 - 1), .Range('M' & Lig2 - 1)).AutoFill _
Destination:=Range(.Range('J' & Lig2 - 1), .Range('M' & Lig1)), Type:=xlFillDefault
End With
Sheets('Equipe 1').Activate: Range('C9').Select
Application.ScreenUpdating = True
End Sub

Message édité par: archi, à: 15/08/2005 12:30

 

[Spock]

Bonjour,

De mémoire, a la fin de ta première macro, écrit Call Equipe_101

 

[_Thierry]

Bonjour Archi, Mr Spock, le Forum

Pour Mr Spock, le Call n'est pas vraiment nécessaire, on peut l'éviter. DE plus moi je n'ai pas compris la demande d'Archi de la Sorte, mais plutot avec un passage d'arguments pour ces Variables afin de n'utiliser qu'un seul code 'Equipe'...

Il est clair que si tu as un décalage défini qui peut avoir une règle on pourait même éviter le Select Case (Plus Sept pour chaque adresse...(?) Mais n'en étant pas certain, le Select Case est plus simple suaf si tu as une Centaine de Case, of Course LOL)

Option Explicit

Const WSBase As String = 'Equipe 1'

Sub TheRunnerAAA()
Dim Rangebase As String
Dim RangeCount As String
Dim RangeCopy As String
Dim RowCopy As Integer
Dim i As Byte

&nbsp; &nbsp; For i = 1 To 2 'Ou bien to 3 ou plus
&nbsp; &nbsp;
&nbsp; &nbsp; &nbsp; &nbsp; Select Case i
&nbsp; &nbsp; &nbsp; &nbsp; Case 1
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Rangebase = 'C2'
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; RangeCount = 'D58'
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; RangeCopy = 'B5'
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; RowCopy = 4
&nbsp; &nbsp; &nbsp; &nbsp; Case 2
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Rangebase = 'C9'
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; RangeCount = 'D1214'
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; RangeCopy = 'B12'
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; RowCopy = 11
&nbsp; &nbsp; &nbsp; &nbsp; 'Case 3
'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Rangebase = 'What You Want'
'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; RangeCount = 'What You Want'
'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; RangeCopy = 'What You Want'
'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; RowCopy = What You Want
&nbsp; &nbsp; &nbsp; &nbsp; End Select
&nbsp; &nbsp;

&nbsp; &nbsp; &nbsp; &nbsp; Equipe Rangebase, RangeCount, RangeCopy, RowCopy
&nbsp; &nbsp; Next i

End Sub



Sub Equipe(Rangebase As String, RangeCount As String, RangeCopy As String, RowCopy As Integer)
Dim Nom As String
Dim Lig1 As Integer, Lig2 As Integer
Dim i As Integer


Application.ScreenUpdating = False
&nbsp; &nbsp; With Sheets(WSBase).Range(Rangebase)
&nbsp; &nbsp; &nbsp; &nbsp; If InStr(1, .Value, ' ') < 1 Then Exit Sub
&nbsp; &nbsp; &nbsp; &nbsp; Nom = Left(.Value, InStr(1, .Value, ' ') + 1) + '.'
&nbsp; &nbsp; &nbsp; &nbsp; Nom = Application.WorksheetFunction.Proper(Nom)
&nbsp; &nbsp; End With

&nbsp; &nbsp; With Sheets(Nom)
&nbsp; &nbsp; &nbsp; &nbsp; Lig1 = .Range('A10000').End(xlUp).Row
&nbsp; &nbsp; &nbsp; &nbsp; Range(.Range('H' & Lig1 + 1), .Range('H' & Lig1 + 3)).Clear
&nbsp; &nbsp; End With
&nbsp; &nbsp;
&nbsp; &nbsp; With Sheets(WSBase)
&nbsp; &nbsp; &nbsp; &nbsp; i = Application.CountA(.Range(RangeCount))
&nbsp; &nbsp; &nbsp; &nbsp; .Range(RangeCopy & ':I' & RowCopy + i).Copy
&nbsp; &nbsp; End With
&nbsp; &nbsp;
&nbsp; &nbsp; With Sheets(Nom) 'Pas vraiment regardé ce Schmilblick LOL !
&nbsp; &nbsp; &nbsp; &nbsp; .Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
&nbsp; &nbsp; &nbsp; &nbsp; .Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
&nbsp; &nbsp; &nbsp; &nbsp; Range(.Range('A4'), .Range('H' & Lig1)).Validation.Delete
&nbsp; &nbsp; &nbsp; &nbsp; Lig1 = .Range('A65536').End(xlUp).Row
&nbsp; &nbsp; &nbsp; &nbsp; Lig2 = .Range('J65536').End(xlUp).Row + 1
&nbsp; &nbsp; &nbsp; &nbsp; .Range('A4:H' & Lig1).Validation.Delete
&nbsp; &nbsp; &nbsp; &nbsp; Range(.Range('A4'), .Range('H' & Lig1)).Sort Key1:=.Range('A4'), Order1:=xlAscending
&nbsp; &nbsp; &nbsp; &nbsp; Range(.Range('J' & Lig2 - 1), .Range('M' & Lig2 - 1)).AutoFill _
&nbsp; &nbsp; &nbsp; &nbsp; Destination:=Range(.Range('J' & Lig2 - 1), .Range('M' & Lig1)), Type:=xlFillDefault
&nbsp; &nbsp; End With
&nbsp; &nbsp;
Sheets(WSBase).Activate: Range(RangeCount).Select

Application.ScreenUpdating = True

End Sub

Si vraiment tu as une centaine de décalage de Sept en Sept... Mais ce qui n'est pas clair car :
D58
D1214 devrait être D1215...

Mais sinon :

Const WSBase As String = 'Equipe 1'

Sub TheRunnerBBB()
Dim Rangebase As String
Dim RangeCount As String
Dim RangeCopy As String
Dim RowCopy As Integer
Dim i As Integer
Dim NumRBase As Integer

NumRBase = 2


&nbsp; &nbsp; For i = 1 To 21 Step 7 'Ou bien >> For i = 1 To 700 Step 7 'Attention MSGBOX !!!!
&nbsp; &nbsp; &nbsp; Rangebase = 'C' & NumRBase
&nbsp; &nbsp; &nbsp; RangeCount = 'D' & NumRBase + 3 & '' & NumRBase + 6
&nbsp; &nbsp; &nbsp; RangeCopy = 'B' & NumRBase + 3
&nbsp; &nbsp; &nbsp; RowCopy = NumRBase + 2
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;
&nbsp; &nbsp; &nbsp; &nbsp; MsgBox Rangebase & ' ' & RangeCount & ' ' & RangeCopy & ' ' & RowCopy
'&nbsp; &nbsp; &nbsp; &nbsp; Equipe Rangebase, RangeCount, RangeCopy, RowCopy
&nbsp; &nbsp; &nbsp;
&nbsp; &nbsp; &nbsp; NumRBase = NumRBase + 7
&nbsp; &nbsp; &nbsp; Next
&nbsp; &nbsp;
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;
End Sub

NB Attention c'est une message bos si tu veux pas cliquer 100 Fois laisse sur 'For i = 1 To 21 Step 7' ...Pour tester...

Bon App
[ol]@+Thierry[/ol]

 

[archi]

Merci thierry de te pencher sur mon problème

malheureusement y un bug au niveau de la ligne:
Sub Equipe(Rangebase As String, RangeCount As String, RangeCopy As String, RowCopy As Integer)

je te joint mon fichier pour simplifier

Ps: j'ai rajouter des cases

bye [file name=Test_BDV7_2_20050815155843.zip size=41680]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Test_BDV7_2_20050815155843.zip[/file]

 

[_Thierry]

Re Bonjour Archi, Spock, le Forum

Non le bug c'est :

'une variable doit être déclarée en tête de module uniquement si on souhaite se re-servir de sa valeur dans plusieurs
'procédures du même module. Dans le cas contraire, il convient de déclarer les variables au niveau procédure
'Dim Tabl
'Dim Lig As Integer, Lig1 As Integer, Lig2 As Integer, Col As Integer, NbPts As Single, NbDef As Integer, NbVic As Integer
'Dim Nom As String, i As Byte

Sub Macro()
Dim Nom As String
Dim lig As Long, Lig1 As Long, Lig2 As Long

Application.ScreenUpdating = False
With Sheets('Saisie individuel').Range('C2')
If InStr(1, .Value, ' ') < 1 Then Exit Sub
Nom = Left(.Value, InStr(1, .Value, ' ') + 1) + '.'
Nom = Application.WorksheetFunction.Proper(Nom)
End With
With Sheets('Saisie individuel')
lig = .Range('C65536').End(xlUp).Row
.Range('B5:J' & lig).Copy
End With
With Sheets(Nom)
Lig1 = .Range('A65536').End(xlUp).Row
.Range('A' & Lig1 + 1).PasteSpecial Paste:=xlPasteFormats
.Range('A' & Lig1 + 1).PasteSpecial Paste:=xlPasteValues
.Range(.Range('A4'), .Range('H' & Lig1)).Validation.Delete
Lig1 = .Range('A65536').End(xlUp).Row
Lig2 = .Range('J65536').End(xlUp).Row + 1
.Range('A4:H' & Lig1).Validation.Delete
.Range(.Range('A4'), .Range('H' & Lig1)).Sort Key1:=.Range('A4'), Order1:=xlAscending
.Range(.Range('J' & Lig2 - 1), .Range('M' & Lig2 - 1)).AutoFill _
Destination:=.Range(.Range('J' & Lig2 - 1), .Range('M' & Lig1)), Type:=xlFillDefault
End With
Sheets('Saisie individuel').Activate
Range('C2').Select
Application.ScreenUpdating = True
End Sub

Sub Macro1()

Qui doit être pûrement et simplement supprimé de ce Module pour ne conserver que ce que je t'ai donné plus haut !!

Bon Courage
[ol]@+Thierry[/ol]

 

[_Thierry]

c'est re moi,

En fait j'ai l'impression que tu as zippé et mis en ligne une autre version du fichier que celle où tu travailles actuellement. Car après lecture je ne vois pas d'autre Case que ceux que j'avais prévus..

Si c'est vraiment cette ligne qui te plante :

Sub Equipe(Rangebase As String, RangeCount As String, RangeCopy As String, RowCopy As Integer)


Et que tu as ajouté des Cases...

Soit tu écris :
Case X
Rangebase = 'C9'
RangeCount = 'D1214'
RangeCopy = 'B12'
RowCopy = 11 '<<< NB Sans double quote

Soit tu écris :
Case X
Rangebase = 'C9'
RangeCount = 'D1214'
RangeCopy = 'B12'
RowCopy = '11'

Et tu corriges RowCopy AS String et plus As Integer... dans la Sub en tant que déclaration ET dans le passage d'arguments...

Bon Courage
[ol]@+Thierry[/ol]

 

[archi]

Excuse moi, mais je débute

tu me demande de supprimer 'Macro()' ??

 

[_Thierry]

Re Archi

On s'est croisé sur mon précédent et dernier Post, je pense que tu ne l'as pas encore lu.

Mais sinon oui dans le fichier que tu as zippé tu dois supprimer tout ce qui est en rouge...

Sinon en anticipant que tu t'es trompé de version de fichiers, tu dois appliquer mes dernières recommandations.

Bon Courage (on a tous débuté )
[ol]@+Thierry[/ol]

 

[archi]

mais je la mais où Macro() ??

 

[_Thierry]

Heuh Archi ?

Désolé Archi, mais tu as fait un apéro chargé pour l'Assomption ou bien ? LOL

Je ne veux pas te vexer mais tu n'as plus besoin de Macro()... Mais juste de ceci :

Option Explicit

Const WSBase As String = 'Equipe 1'
Sub TheRunnerAAA()
Dim Rangebase As String
Dim RangeCount As String
Dim RangeCopy As String
Dim RowCopy As Integer
Dim i As Byte

    For i = 1 To 2 'Ou bien to 3 ou plus
   
        Select Case i
        Case 1
            Rangebase = 'C2'
            RangeCount = 'D58'
            RangeCopy = 'B5'
            RowCopy = 4
        Case 2
            Rangebase = 'C9'
            RangeCount = 'D1214'
            RangeCopy = 'B12'
            RowCopy = 11
        'Case 3
'            Rangebase = 'What You Want'
'            RangeCount = 'What You Want'
'            RangeCopy = 'What You Want'
'            RowCopy = What You Want
        End Select
   

        Equipe Rangebase, RangeCount, RangeCopy, RowCopy
    Next i

End Sub



Sub Equipe(Rangebase As String, RangeCount As String, RangeCopy As String, RowCopy As Integer)
Dim Nom As String
Dim Lig1 As Integer, Lig2 As Integer
Dim i As Integer


Application.ScreenUpdating = False
    With Sheets(WSBase).Range(Rangebase)
        If InStr(1, .Value, ' ') < 1 Then Exit Sub
        Nom = Left(.Value, InStr(1, .Value, ' ') + 1) + '.'
        Nom = Application.WorksheetFunction.Proper(Nom)
    End With

    With Sheets(Nom)
        Lig1 = .Range('A10000').End(xlUp).Row
        Range(.Range('H' & Lig1 + 1), .Range('H' & Lig1 + 3)).Clear
    End With
   
    With Sheets(WSBase)
        i = Application.CountA(.Range(RangeCount))
        .Range(RangeCopy & ':I' & RowCopy + i).Copy
    End With
   
    With Sheets(Nom) 'Pas vraiment regardé ce Schmilblick LOL !
        .Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
        .Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        Range(.Range('A4'), .Range('H' & Lig1)).Validation.Delete
        Lig1 = .Range('A65536').End(xlUp).Row
        Lig2 = .Range('J65536').End(xlUp).Row + 1
        .Range('A4:H' & Lig1).Validation.Delete
        Range(.Range('A4'), .Range('H' & Lig1)).Sort Key1:=.Range('A4'), Order1:=xlAscending
        Range(.Range('J' & Lig2 - 1), .Range('M' & Lig2 - 1)).AutoFill _
        Destination:=Range(.Range('J' & Lig2 - 1), .Range('M' & Lig1)), Type:=xlFillDefault
    End With
   
Sheets(WSBase).Activate: Range(Rangebase).Select

Application.ScreenUpdating = True

End Sub

Et rien d'autre

Bon Courage
[ol]@+Thierry[/ol]


EDITION !!!

PS en fait je commence à y perdre mon latin avec cette macro qui se répète mais apparemment tu n'es plus sur la même feuille, alors là c'est différents, ce n'est plus ce que tu avais énnoncé au début... il faudrait aussi passer en argument le nom de feuille dans ce cas....

Message édité par: _Thierry, à: 15/08/2005 17:02

Message édité par: _Thierry, à: 15/08/2005 17:03

 

[archi]

mais comment je ventile mes données qui se trouve dans la feuille 'Saisie individuel' si je n'ai pas le code 'Macro()' ??

PS jéte un oeil dans mon fichier

Message édité par: archi, à: 15/08/2005 17:04

 

[_Thierry]

Bon Archi

Postes ton fichier avec la dernière version celle où tu as un bug quand tu as ajouté des Select Cases ...

Je vais essayer de t'arranger ceci

[ol]@+Thierry[/ol]

 

[archi]

je l'ai déjà poster plus haut !!

 

[_Thierry]

Archi

Je vais devoir partir dans pas longtemps, c'est un dilogue de sourd, tu as écrit :

1)
malheureusement y un bug au niveau de la ligne:
Sub Equipe(Rangebase As String, RangeCount As String, RangeCopy As String, RowCopy As Integer)

Avec le fichier que tu as joint si tu supprimes ce que j'ai dit, il n'y a aucun bug.

2)
Ps: j'ai rajouter des cases

Avec le fichier que tu as joint il n'y a strictement QUE les cases que j'ai indiqué.

Par conséquent je ne peux me mettre dans le cas que tu sites...

En outre j'ai essayé d'anticiper sur la cause possible d'un Bug sur la Ligne :
Sub Equipe(Rangebase As String, RangeCount As String, RangeCopy As String, RowCopy As Integer)

Voir mon Post de 16:37

Bon Courage
[ol]@+Thierry[/ol]

 

[archi]

je te redonne mon fichier d'origine [file name=Test_BDV8_20050815173646.zip size=46720]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Test_BDV8_20050815173646.zip[/file]