faire cohabiter 2 macro dans un module sous excel??
faire cohabiter 2 macro dans un module sous excel?? - VB/VBA/VBS - Programmation
Marsh Posté le 06-09-2005 à 15:26:56
copier-coller
si la sub equipe est la meme une seule suffira
donc ca donne :
|
Marsh Posté le 06-09-2005 à 15:28:25
les trois sub sont donc dans le meme module avec la constant WBase déclarée une seule fois
apres ca tu peux supprimer le module en trop.
tout simplement...
Marsh Posté le 06-09-2005 à 18:40:28
merci pour tous je vais me mettre au boulot
pour ce qui est de la constant Wbase, j'enlève quoi dans les lignes:
Option Explicit
Public Const WSBase As String = "Feuille D2"
car j'ai d'autres modules de ce genre ??
PS: étons obligé de passer par des modules pour ce genre de macro ??
bye
Message édité par archi57 le 06-09-2005 à 18:44:57
Marsh Posté le 08-09-2005 à 21:40:59
un seul module donc les deux doivent etre presentes mais une seule fois
Sujets relatifs:
- Cherche macro pour incrémenter une chaine nombre dans un texte
- [RESOLU] macro,plus de macro...comprend pas tout... (excel)
- Macro dans Macro
- [RESOLU] Excel : macro qui marche, mais boutton qui marche pas !
- Module de Classe et Type defini par l'utilisateur
- Copier par macro une page d'un userform
- Sauvegarde Classeur Excel dans un VBS
- [RESOLU] Date: mois-année, bien la galere... (excel)
Marsh Posté le 06-09-2005 à 13:00:12
Bsr,
voilà j'ai une macro (D2_A) dans le module 1 et une autre (D2_X) dans le module 2.
La question est: comment faire cohabiter 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 = "D5:D8"
RangeCopy = "B5"
RowCopy = 4
Case 2
Rangebase = "C10"
RangeCount = "D13:D16"
RangeCopy = "B13"
RowCopy = 12
Case 3
Rangebase = "C18"
RangeCount = "D21:D24"
RangeCopy = "B21"
RowCopy = 20
Case 4
Rangebase = "C26"
RangeCount = "D29:D32"
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 = "D37:D40"
RangeCopy = "B37"
RowCopy = 36
Case 2
Rangebase = "C42"
RangeCount = "D45:D48"
RangeCopy = "B45"
RowCopy = 44
Case 3
Rangebase = "C50"
RangeCount = "D53:D56"
RangeCopy = "B53"
RowCopy = 52
Case 4
Rangebase = "C58"
RangeCount = "D61:D64"
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
Message édité par archi57 le 06-09-2005 à 13:02:28