fonction Hlookup vba

Bonsoir Franck,
J'ai un peu modifié ta proc pour qu'elle soit plus claire (enfin j'espère) :

Sub RECHERCHEH()
Dim oWk As Workbook
Dim Fe As Worksheet
Dim Tbl As String
Dim Ligne As Long
Dim start_plage_initial As Long
Dim I As Long
Dim Critere As String

'modifier les 2 valeurs suivantes
'en fonction des besoins
start_plage_initial = 1
I = 2

'Valeur cherchée
Critere = "ASSIS"

Set oWk = ThisWorkbook
Set Fe = oWk.Sheets("Courbe en S")

'défini le tableau
Tbl = Fe.Range(Fe.Cells(start_plage_initial, 1), _
Fe.Cells(I, 7)).Address

'dernière ligne
Ligne = Fe.Range(Tbl).End(xlDown).Row

'résultat
Fe.Cells(I + 3, 2) = _
Application.WorksheetFunction.HLookup(Critere, _
Range(Tbl), _
Ligne, _
False)

Set Fe = Nothing
Set oWk = Nothing
End Sub

Hervé.


"franck B" <franckB@discussions.microsoft.com> a écrit dans le message de
news: 4535E91E-38B6-4664-B634-875CDE53E39E@microsoft.com...

bonjour à tous,

j'ai un probleme avec la fonction Hlookup en mode VBA. je cherche à copier
une cellule appartenant à un fichier vers une feuille d'un second fichier
en

cherchant avec Hlookup. cependant à l'execution, j'ai le message d'erreur
suivant :

erreur 1004 définie par l'application ou par l'objet

voici la ligne de code correspondante:
Sheets("Courbe en S").Cells(i + 3, 2) > Application.WorksheetFunction.HLookup("ASSIS", oWk.Sheets("Operational
report

- detailed l").Range(oWk.Sheets("Operational report - detailed
l").Cells(start_plage_initial, 1), oWk.Sheets("Operational report -
detailed

l").Cells(i, 7)), oWk.Sheets("Operational report - detailed
l").Range(Cells(start_plage_initial, 1), Cells(i, 7)).End(xlDown).Row,
False)

je repete la ligne plusieurs fois pour copier beaucoup de cellules, de
maniere identique

si quelqu'un voit une faille ou la source de l'erreur, qu'il n'hésite pas

d'abord merci de ta réponse, je suis en train de l'etudier en ce moment même.

pour te replacer dans le contexte, je te met la méthode complete, sans bien
sur toutes les copies à traiter.
si tu vois une spécificité au code que tu m'as proposé pour cette methode,
n'hesite pas

Sub import_courbe_S()
Dim oExcel As Excel.Application
Dim oWk As Workbook
Dim myrange As Range
Set oExcel = CreateObject("Excel.Application")
On Error Resume Next 'Pour éviter les erreur si classeur n'existe pas
Set oWk = oExcel.Workbooks.Open(ThisWorkbook.Path & "Operational report
- detailed loads V4.txt")
On Error GoTo 0
If oWk Is Nothing Then
MsgBox "Erreur sur l'ouverture du classeur", vbCritical
Exit Sub
End If

I = 1
j = 1
k = 1
vi = 1
vii = 1
viii = 1
viiii = 1

'recherhche de la zone du code projet sur lequel on va mettre à jour les
charges
If Cockpit.cp_import_courbeS.Value = "" Then
MsgBox "code projet non spécifié pour l'importation de données",
vbCritical
oExcel.Quit
Exit Sub
End If
If Cockpit.cp_import_courbeS.Value <> oWk.Sheets("Operational report -
detailed l").Cells(3, 1) Then
MsgBox "Le projet sélectionné ne correspond pas au fichier d'import
fourni, sélectionnez un autre projet ou vérifiez votre fichier d'import",
vbCritical
oExcel.Quit
Exit Sub
End If
While ThisWorkbook.Sheets("Courbe en S").Cells(I, 2) <> "Initial tickets
Loads" And ThisWorkbook.Sheets("Courbe en S").Cells(I + 1, 2) <>
Cockpit.cp_import_courbeS.Value
I = I + 1
j = j + 1
k = k + 1

Wend
'********************************************************************

'recherche des charges initiales sur le fichier d'import pour le code projet
extrait de BO
While oWk.Sheets("Operational report - detailed l").Cells(vi, 1) <> "Initial
tickets Loads"
vi = vi + 1
start_plage_initial = vi + 1
Wend
'********************************************************************
vi = vi + 3
While oWk.Sheets("Operational report - detailed l").Cells(vi, 1) <> ""
If Sheets("Courbe en S").Cells(I + 3, 2) = "" And Sheets("Courbe en
S").Cells(I + 3 - 1, 2) <> "" Then
Sheets("Courbe en S").Select
Range(Sheets("Courbe en S").Cells(I + 3, 1), Sheets("Courbe en
S").Cells(I + 3, 19)).Insert xlShiftDown
I = I + 1
End If

'On Error Resume Next
oWk.Sheets("Operational report - detailed l").Select
'myrange = oWk.ActiveSheet.Range(start_plage_initial, 1), Cells(vi, 7))
On Error Resume Next
myrange = Sheets("Operational report - detailed
l").Range(Cells(start_plage_initial, 1), Cells(vi, 7)).Select
On Error GoTo 0
If myrange Is Nothing Then
MsgBox "erreur sur la lecture du fichier source", vbCritical
Exit Sub
End If

Sheets("Courbe en S").Cells(I + 3, 2) =
Application.WorksheetFunction.HLookup("ASSIS", myrange,
myrange.End(xlDown).Row, False)

I = I + 1
vi = vi + 1
Wend

oExcel.Quit
Sheets("Paramètres").Cells(1, 2) = ThisWorkbook.Path & "Operational report
- detailed loads V4.txt"
MsgBox "Importation des données pour " & Cockpit.cp_import_courbeS.Value & "
terminée", vbInformation

la fonction que tu m'as donné ne semble pas marcher, j'obtiens un message
d'erreur classique sur l'utilisation des fonctions via l'objet
worksheetfunction "erreur 1004 impossible de lire la propriété de l'objet
worksheetfunction"

j'ai donc mis une gestion d'erreur pour gerer cela, mais le probleme viens
du fait que le tableau tbl reste vide apres l'affectation.

d'abord merci de ta réponse, je suis en train de l'etudier en ce moment même.

pour te replacer dans le contexte, je te met la méthode complete, sans bien
sur toutes les copies à traiter.
si tu vois une spécificité au code que tu m'as proposé pour cette methode,
n'hesite pas

Sub import_courbe_S()
Dim oExcel As Excel.Application
Dim oWk As Workbook
Dim myrange As Range
Set oExcel = CreateObject("Excel.Application")
On Error Resume Next 'Pour éviter les erreur si classeur n'existe pas
Set oWk = oExcel.Workbooks.Open(ThisWorkbook.Path & "Operational report
- detailed loads V4.txt")
On Error GoTo 0
If oWk Is Nothing Then
MsgBox "Erreur sur l'ouverture du classeur", vbCritical
Exit Sub
End If

I = 1
j = 1
k = 1
vi = 1
vii = 1
viii = 1
viiii = 1

'recherhche de la zone du code projet sur lequel on va mettre à jour les
charges
If Cockpit.cp_import_courbeS.Value = "" Then
MsgBox "code projet non spécifié pour l'importation de données",
vbCritical
oExcel.Quit
Exit Sub
End If
If Cockpit.cp_import_courbeS.Value <> oWk.Sheets("Operational report -
detailed l").Cells(3, 1) Then
MsgBox "Le projet sélectionné ne correspond pas au fichier d'import
fourni, sélectionnez un autre projet ou vérifiez votre fichier d'import",
vbCritical
oExcel.Quit
Exit Sub
End If
While ThisWorkbook.Sheets("Courbe en S").Cells(I, 2) <> "Initial tickets
Loads" And ThisWorkbook.Sheets("Courbe en S").Cells(I + 1, 2) <>
Cockpit.cp_import_courbeS.Value
I = I + 1
j = j + 1
k = k + 1

Wend
'********************************************************************

'recherche des charges initiales sur le fichier d'import pour le code projet
extrait de BO
While oWk.Sheets("Operational report - detailed l").Cells(vi, 1) <> "Initial
tickets Loads"
vi = vi + 1
start_plage_initial = vi + 1
Wend
'********************************************************************
vi = vi + 3
While oWk.Sheets("Operational report - detailed l").Cells(vi, 1) <> ""
If Sheets("Courbe en S").Cells(I + 3, 2) = "" And Sheets("Courbe en
S").Cells(I + 3 - 1, 2) <> "" Then
Sheets("Courbe en S").Select
Range(Sheets("Courbe en S").Cells(I + 3, 1), Sheets("Courbe en
S").Cells(I + 3, 19)).Insert xlShiftDown
I = I + 1
End If

'On Error Resume Next
oWk.Sheets("Operational report - detailed l").Select
'myrange = oWk.ActiveSheet.Range(start_plage_initial, 1), Cells(vi, 7))
On Error Resume Next
myrange = Sheets("Operational report - detailed
l").Range(Cells(start_plage_initial, 1), Cells(vi, 7)).Select
On Error GoTo 0
If myrange Is Nothing Then
MsgBox "erreur sur la lecture du fichier source", vbCritical
Exit Sub
End If

Sheets("Courbe en S").Cells(I + 3, 2) =
Application.WorksheetFunction.HLookup("ASSIS", myrange,
myrange.End(xlDown).Row, False)

I = I + 1
vi = vi + 1
Wend

oExcel.Quit
Sheets("Paramètres").Cells(1, 2) = ThisWorkbook.Path & "Operational report
- detailed loads V4.txt"
MsgBox "Importation des données pour " & Cockpit.cp_import_courbeS.Value & "
terminée", vbInformation