Fusionner 2 modules

[archi]

Bsr,

voilà j'ai une macro (D2_A) dans le module 1 et une autre (D2_X) dans le module 2.
La question est: peut on insérer ces deux macros dans un seul module ??

Merci
bye

Macro (D2_A):

Option Explicit

Public Const WSBase As String = 'Feuille D2'
Sub D2_A()
Dim Rangebase As String
Dim RangeCount As String
Dim RangeCopy As String
Dim RowCopy As Integer
Dim i As Byte

For i = 1 To 4

Select Case i
Case 1
Rangebase = 'C2'
RangeCount = 'D58'
RangeCopy = 'B5'
RowCopy = 4
Case 2
Rangebase = 'C10'
RangeCount = 'D1316'
RangeCopy = 'B13'
RowCopy = 12
Case 3
Rangebase = 'C18'
RangeCount = 'D2124'
RangeCopy = 'B21'
RowCopy = 20
Case 4
Rangebase = 'C26'
RangeCount = 'D2932'
RangeCopy = 'B29'
RowCopy = 28
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)
.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('D2').Activate
Range('C5').Select

Application.ScreenUpdating = True
End Sub

Macro (D2_X):

Option Explicit

Public Const WSBase As String = 'Feuille D2'
Sub D2_X()
Dim Rangebase As String
Dim RangeCount As String
Dim RangeCopy As String
Dim RowCopy As Integer
Dim i As Byte

For i = 1 To 4

Select Case i
Case 1
Rangebase = 'C34'
RangeCount = 'D3740'
RangeCopy = 'B37'
RowCopy = 36
Case 2
Rangebase = 'C42'
RangeCount = 'D4548'
RangeCopy = 'B45'
RowCopy = 44
Case 3
Rangebase = 'C50'
RangeCount = 'D5356'
RangeCopy = 'B53'
RowCopy = 52
Case 4
Rangebase = 'C58'
RangeCount = 'D6164'
RangeCopy = 'B61'
RowCopy = 60
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)
.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('D2').Activate
Range('C38').Select

Application.ScreenUpdating = True
End Sub

 

[PascalXLD]

Bonjour

Première réponse Oui tes macros peuvent être dans l emême module

Par contre deux choses m'étonnent à première vue

Tu as deux macros identiques portant le même nom dans les 2 modules. Cela ne se fait pas et ne sert à rien

Tu as déclaré une variable Public 2 fois 1 fois dans chaque module. Cela ne se fait pas et ne sert à rien tu ne la declares qu'une fois dans un seul module et tous les modules et userform la verront

Bon courage

 

[_Thierry]

Bonsoir Archi, le Forum

Oui bien sûr, pour autant que tu ne doublonnes pas la Sub de réception des paramètres (Equipe)

Par contre je n'ai pas vérifié si Equipe avait bien les même fonctionnalités dans les deux versions (Le jeu des Septs Erreurs, je n'aime bien que sur des dessins )

Bonne Soirée
[ol]@+Thierry[/ol]

 

[_Thierry]

Salut Pascal, pardon pas vu et boum !! lol

Ah oui aussi je complète et confirme pour la Variable Public 'WSBase' (of course ça m'avait échappé ça lol)

Bonne Soirée, je file maintenant
[ol]@+Thierry[/ol]

 

[archi]

Merci à vous deux, néanmoins en tant que néophite, je ne voit pas comment faire pour lier ses deux macro