1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
| Private Sub CommandButton4_Click()
MsgBox "ATTENTION, cela peu prendre un peu de temps, veuillez attendre sagement"
Sheets("feuille_de_prix").Select
'For i = 11 To 81 Step 5
'ICI L'INITIALISATION DE LA BOUCLE
Dim rngArticle As Range
Dim myWs As Worksheet
Set myWs = ThisWorkbook.ActiveSheet
Set rngArticle = myWs.Range(myWs.Range("K4"), myWs.Range("K65536").End(xlUp))
'Set rngArticle = myWs.Range(myWs.Range(Cells(4, i)), myWs.Range(Cells(65536, i)).End(xlUp))
'ICI JE VOUDRAIT REMPLACER LA LIGNE D'AU DESSUS PAR CELLE SI, OU DU MOIN UN TRUC QUI VOUDRAIT DIRE LA MEME CHOSE ET QUI FONCTIONNE ^^
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
Dim xlWk As Workbook
Set xlWk = xlApp.Workbooks.Open("C:\Users\fichier_source.xls")
Dim xlWs As Worksheet
Set xlWs = xlWk.Worksheets(1)
Dim rngArticleRecherche As Range
Set rngArticleRecherche = xlWs.Range(xlWs.Range("B2"), xlWs.Range("B65536").End(xlUp))
Dim rngRefTrouve As Range
Dim cell As Range
For Each cell In rngArticle
Set rngRefTrouve = rngArticleRecherche.Find(cell.Value, , xlValues, xlWhole)
If rngRefTrouve Is Nothing Then
Else
cell.Offset(, 1).Value = rngRefTrouve.Offset(, 6).Value
End If
'Next SANS OUBLIER LE NEXT DE LA BOUCLE
Next
Set xlWs = Nothing
xlWk.Close (False)
Set xlWk = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub |
Partager