Caninge
XLDnaute Accro
Bonjour à Tous........
Je posséde cette macro aimablement suggérée il y a quelques
jours qui fonctionne bien mais que je veux modifier !!!
Je joins un petit fichier en espérant que vous allez me comprendre
Merci!!!!!
Private Sub Worksheet_Activate()
pression1 = False
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range('B4,D4,F4,H4')) Is Nothing Then
pression1 = False
Exit Sub
End If
If pression1 = False Then
source1 = Target.Address(0, 0)
pression1 = True
Else
source2 = Target.Address(0, 0)
pression1 = False
'Nomazy-Village au Crédit Agricole
If source1 = 'B4' And source2 = 'D4' Or _
source1 = '' And source2 = '' Then
With Sheets('Reports')
Sheets('Route').Range('Plage1').Copy .Range('a' & .Range('a65536').End(xlUp).Row + 1)
MsgBox 'Transfert effectué', , 'Le parcours'
End With
End If
'Crédit Agricole à Chapeau
If source1 = 'D4' And source2 = 'F4' Or _
source1 = '' And source2 = '' Then
With Sheets('Reports')
Sheets('Route').Range('Plage1').Copy .Range('a' & .Range('a65536').End(xlUp).Row + 1)
MsgBox 'Transfert effectué', , 'Le parcours'
End With
End If
'Chapeau à Thiel
If source1 = 'F4' And source2 = 'H4' Or _
source1 = '' And source2 = '' Then
With Sheets('Reports')
Sheets('Route').Range('Plage1').Copy .Range('a' & .Range('a65536').End(xlUp).Row + 1)
MsgBox 'Transfert effectué', , 'Le parcours'
End With
End If [file name=NouvelleMAcro.zip size=2070]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/NouvelleMAcro.zip[/file]
Je posséde cette macro aimablement suggérée il y a quelques
jours qui fonctionne bien mais que je veux modifier !!!
Je joins un petit fichier en espérant que vous allez me comprendre
Merci!!!!!
Private Sub Worksheet_Activate()
pression1 = False
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range('B4,D4,F4,H4')) Is Nothing Then
pression1 = False
Exit Sub
End If
If pression1 = False Then
source1 = Target.Address(0, 0)
pression1 = True
Else
source2 = Target.Address(0, 0)
pression1 = False
'Nomazy-Village au Crédit Agricole
If source1 = 'B4' And source2 = 'D4' Or _
source1 = '' And source2 = '' Then
With Sheets('Reports')
Sheets('Route').Range('Plage1').Copy .Range('a' & .Range('a65536').End(xlUp).Row + 1)
MsgBox 'Transfert effectué', , 'Le parcours'
End With
End If
'Crédit Agricole à Chapeau
If source1 = 'D4' And source2 = 'F4' Or _
source1 = '' And source2 = '' Then
With Sheets('Reports')
Sheets('Route').Range('Plage1').Copy .Range('a' & .Range('a65536').End(xlUp).Row + 1)
MsgBox 'Transfert effectué', , 'Le parcours'
End With
End If
'Chapeau à Thiel
If source1 = 'F4' And source2 = 'H4' Or _
source1 = '' And source2 = '' Then
With Sheets('Reports')
Sheets('Route').Range('Plage1').Copy .Range('a' & .Range('a65536').End(xlUp).Row + 1)
MsgBox 'Transfert effectué', , 'Le parcours'
End With
End If [file name=NouvelleMAcro.zip size=2070]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/NouvelleMAcro.zip[/file]