archi57 | 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):
Citation :
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):
Citation :
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
|
