VBA - Problème VLookup

[debidebo67]

Bonjour,

Pourriez-vous m'indiquer pourquoi le code ne fonctionne pas, où se trouve l'erreur SVP !?!
il ne me marque aucune valeur et ne m'indique aucun message d'erreur !?!

Merci

Sub PU_saisie()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim i As Integer
Dim saisi As String

i = 6 'ligne1 feuille saisie
saisi = Sheets("saisie").Range("A" & i).Value

'1.1
If saisi = "1.1" Then
For Each P In Worksheets("saisie").Range("I6:I506")
If Sheets("saisie").Range("H" & i).Value < 500 Then
P = Application.WorksheetFunction.VLookup("1.1.1", Worksheets("Devis de base").Range("A17:E300"), 5, False)
ElseIf Sheets("saisie").Range("H" & i).Value > 1000 Then
P = Application.WorksheetFunction.VLookup("1.1.3", Worksheets("Devis de base").Range("A17:E300"), 5, False)
Else
P = Application.WorksheetFunction.VLookup("1.1.2", Worksheets("Devis de base").Range("A17:E300"), 5, False)
i = i + 1
End If
Next
End If

Range("B5").Select

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Yaloo]

Re : VBA - Problème VLookup

Bonsoir debidebo67,

Sans fichier, ça va être compliqué.

A+

Martial

 

[Pierrot93]

Re : VBA - Problème VLookup

Bonjour,

déjà à priori ton incrémentation du i est mal placé.... mais de toute façon me semble inutile on devrait pouvoir s'en passer.... un essai comme ci dessous, mais pas testé.... pas la matière première.... A toi de jouer...

Option Explicit
Sub PU_saisie()
Dim p As Range, p2 As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set p2 = Worksheets("Devis de base").Range("A17:E300")
For Each p In Worksheets("saisie").Range("I6:I506")
    If p.Offset(0, -1).Value < 500 Then
        p = Application.WorksheetFunction.VLookup("1.1.1", p2, 5, False)
    ElseIf p.Offset(0, -1).Value.Value > 1000 Then
        p = Application.WorksheetFunction.VLookup("1.1.3", p2, 5, False)
    Else
        p = Application.WorksheetFunction.VLookup("1.1.2", p2, 5, False)
    End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

bonne journée
@+