exécuter 2 macros en même temps

archi · 15 Août 2005

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 · 15 Août 2005

Bonjour,

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

_Thierry · 15 Août 2005

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

    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(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

    For i = 1 To 21 Step 7 'Ou bien >> For i = 1 To 700 Step 7 'Attention MSGBOX !!!!
      Rangebase = 'C' & NumRBase
      RangeCount = 'D' & NumRBase + 3 & '' & NumRBase + 6
      RangeCopy = 'B' & NumRBase + 3
      RowCopy = NumRBase + 2
           
        MsgBox Rangebase & ' ' & RangeCount & ' ' & RangeCopy & ' ' & RowCopy
'        Equipe Rangebase, RangeCount, RangeCopy, RowCopy
     
      NumRBase = NumRBase + 7
      Next
   
           
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 · 15 Août 2005

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 · 15 Août 2005

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 · 15 Août 2005

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 · 15 Août 2005

Excuse moi, mais je débute

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

_Thierry · 15 Août 2005

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 · 15 Août 2005

mais je la mais où Macro() ??

_Thierry · 15 Août 2005

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 · 15 Août 2005

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 · 15 Août 2005

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 · 15 Août 2005

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

_Thierry · 15 Août 2005

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 · 15 Août 2005

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]

exécuter 2 macros en même temps

archi

XLDnaute Impliqué

Spock

XLDnaute Occasionnel

_Thierry

XLDnaute Barbatruc

archi

XLDnaute Impliqué

Pièces jointes

_Thierry

XLDnaute Barbatruc

_Thierry

XLDnaute Barbatruc

archi

XLDnaute Impliqué

_Thierry

XLDnaute Barbatruc

archi

XLDnaute Impliqué

_Thierry

XLDnaute Barbatruc

archi

XLDnaute Impliqué

_Thierry

XLDnaute Barbatruc

archi

XLDnaute Impliqué

_Thierry

XLDnaute Barbatruc

archi

XLDnaute Impliqué

Pièces jointes

Discussions similaires