macro en panne

[Caninge]

Bonjour à tous

je posséde cette macro qui fonctionnait bien mais depuis que j'ai rajouté Nomazy village au Crédit Agricole et Crédit Agricole à Toulon sur Allier (les 2 dernières) .Celles-Là même ne mache pas

Pourquoi

je vous remercie

Private Sub Worksheet_Activate()
pression1 = False
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Intersect(Target, Range('FO43,FJ32,FF28,FA14,EX15,EP17,EK30,EF37,DV47,DF44,DD44')) 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 à Pont Régemortes côté Ville
If source1 = 'FF28' And source2 = 'FA14' Or _
source1 = '' And source2 = '' Then

With Sheets('Reports')
Sheets('Route').Range('Plage1').Copy .Range('a' & .Range('a65536').End(xlUp).Row + 1)
Sheets('CarteA').Range('A1').Select
MsgBox (' Transfert effectué')
End With
End If

'Pont Régemortes côté Ville à Pont Régemortes côté La Madeleine
If source1 = 'FA14' And source2 = 'EX15' Or _
source1 = '' And source2 = '' Then

With Sheets('Reports')
Sheets('Route').Range('Plage2').Copy .Range('a' & .Range('a65536').End(xlUp).Row + 1)
Sheets('CarteA').Range('A1').Select
MsgBox (' Transfert effectué')
End With
End If

'Pont Régemortes côté La Madeleine aux Côtes de Vallières
If source1 = 'EX15' And source2 = 'EP17' Or _
source1 = '' And source2 = '' Then

With Sheets('Reports')
Sheets('Route').Range('Plage3').Copy .Range('a' & .Range('a65536').End(xlUp).Row + 1)
Sheets('CarteA').Range('A1').Select
MsgBox (' Transfert effectué')
End With
End If

'Côtes de Vallières à Bressoles
If source1 = 'EP17' And source2 = 'EK30' Or _
source1 = '' And source2 = '' Then

With Sheets('Reports')
Sheets('Route').Range('Plage4').Copy .Range('a' & .Range('a65536').End(xlUp).Row + 1)
Sheets('CarteA').Range('A1').Select
MsgBox (' Transfert effectué')
End With

'Nomazy -Village au Crédit Agricole
If source1 = 'FF28' And source2 = 'FJ32' Or _
source1 = '' And source2 = '' Then

With Sheets('Reports')
Sheets('Route').Range('Plage5').Copy .Range('a' & .Range('a65536').End(xlUp).Row + 1)
Sheets('CarteA').Range('A1').Select
MsgBox (' Transfert effectué')
Sheets('CarteA').Range('A1').Select
MsgBox (' Transfert effectué')
End With
End If

'Crédit Agricole à Toulon sur AllierIf source1 = 'FJ32' And source2 = 'FO43' Or _
source1 = '' And source2 = '' Then

With Sheets('Reports')
Sheets('Route').Range('Plage6').Copy .Range('a' & .Range('a65536').End(xlUp).Row + 1)
Sheets('CarteA').Range('A1').Select
MsgBox (' Transfert effectué')
End WithEnd If
End If
End If
End Sub

 

[Robert]

Bonsoir Caninge, bonsoir le forum,

Si je respecte tes conditions If... End If, il semblerait qu'il manque un End If avant Nomazy -Village au Crédit Agricole et qu'il y en ai un en trop à la fin ou plutôt que celui de la fin soit mal placé. Il faudrait le déplacer avant Nomazy -Village au Crédit Agricole.

 

[CBernardT]

Bonsoir Robert et Robert,

je te propose la macro et des petites modifs :


Option Explicit
Dim Pression1
Private Sub Worksheet_Activate()
Pression1 = False
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim source1
Dim source2

If Intersect(Target, Range('FO43,FJ32,FF28,FA14,EX15,EP17,EK30,EF37,DV47,DF44,DD44')) 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 à Pont Régemortes côté Ville
If source1 = 'FF28' And source2 = 'FA14' Or _
source1 = '' And source2 = '' Then

With Sheets('Reports')
Sheets('Route').Range('Plage1').Copy .Range('A' & .Range('a65536').End(xlUp).Row + 1)
Sheets('CarteA').Range('A1').Select
MsgBox (' Transfert effectué')
End With
End If

'Pont Régemortes côté Ville à Pont Régemortes côté La Madeleine
If source1 = 'FA14' And source2 = 'EX15' Or _
source1 = '' And source2 = '' Then

With Sheets('Reports')
Sheets('Route').Range('Plage2').Copy .Range('A' & .Range('a65536').End(xlUp).Row + 1)
Sheets('CarteA').Range('A1').Select
MsgBox (' Transfert effectué')
End With
End If

'Pont Régemortes côté La Madeleine aux Côtes de Vallières
If source1 = 'EX15' And source2 = 'EP17' Or _
source1 = '' And source2 = '' Then

With Sheets('Reports')
Sheets('Route').Range('Plage3').Copy .Range('A' & .Range('a65536').End(xlUp).Row + 1)
Sheets('CarteA').Range('A1').Select
MsgBox (' Transfert effectué')
End With
End If

'Côtes de Vallières à Bressoles
If source1 = 'EP17' And source2 = 'EK30' Or _
source1 = '' And source2 = '' Then

With Sheets('Reports')
Sheets('Route').Range('Plage4').Copy .Range('A' & .Range('a65536').End(xlUp).Row + 1)
Sheets('CarteA').Range('A1').Select
MsgBox (' Transfert effectué')
End With

'Nomazy -Village au Crédit Agricole
If source1 = 'FF28' And source2 = 'FJ32' Or _
source1 = '' And source2 = '' Then

With Sheets('Reports')
Sheets('Route').Range('Plage5').Copy .Range('A' & .Range('a65536').End(xlUp).Row + 1)
Sheets('CarteA').Range('A1').Select
MsgBox (' Transfert effectué')
End With
End If

'Crédit Agricole à Toulon sur Allier
If source1 = 'FJ32' And source2 = 'FO43' Or _
source1 = '' And source2 = '' Then

With Sheets('Reports')
Sheets('Route').Range('Plage6').Copy .Range('A' & .Range('a65536').End(xlUp).Row + 1)
Sheets('CarteA').Range('A1').Select
MsgBox (' Transfert effectué')
End With
End If
End If
End If
End Sub

Cordialement

Bernard

Message édité par: CBernardT, à: 08/10/2005 23:12

 

[Caninge]

Bonjour Bernard et Robert

Je ne dois pas avoir de bonnes lunettes.

Avec If ou sans if on finit par se perdre.

Je regarde la modif et je vous tiens au courant.

Merci et bon dimanche!

CANINGE

 

[Caninge]

Bonjour Bernard et Robert

Bernard, j'ai regardé vite fait les modifs que tu veux m'apporter.

Mais je ne comprends pas trop.

Est-ce que les modifs apportent de l'amélioration ?

Merci