Function cherch(nomF As String, valCherch As String) As Integer 'fonction de recherche... '********************************************************** ' recherche la valeur 'valCherch' et nous indique le ' N° de ligne où elle se trouve VcLig / VcCol '********************************************************** Dim vc As Variant Sheets(nomF).Activate Sheets(nomF).Cells(1, 1).Activate Set vc = Cells.Find(what:=valCherch, lookAt:=xlWhole, After:=ActiveCell, SearchOrder:=xlByColumns, SearchDirection:=xlNext, LookIn:=xlValues, MatchCase:=False, SearchFormat:=False) If Not vc Is Nothing Then cherchC = vc.Row End If End Function
Const Parcours = 6 Const Col1 = 1 Const jour = 1 Const pds = 8 Const tps = 9 Const my = 10 Const dn = 11 Sub extrait_cotes() j = 2 'recherche de la valeur 370 i = cherch(ActiveSheet.Name, "370") 'recuperation des valeurs A = Cells(i, jour).Value B = Cells(i, tps).Value C = Cells(i, my).Value D = Cells(i, pds).Value 'recopie des valeurs : With Sheets("Faron") If .Cells(j, 1).Value = "" Then .Cells(j, 1).Value = A .Cells(j, 2).Value = B .Cells(j, 3).Value = C .Cells(j, 4).Value = D j = j + 1 End If End With End Sub Function cherch(nomF As String, valCherch As String) As Integer 'fonction de recherche... '********************************************************** ' recherche la valeur 'valCherch' et nous indique le ' N° de ligne où elle se trouve VcLig / VcCol '********************************************************** Dim vc As Variant Sheets(nomF).Activate Sheets(nomF).Cells(1, 1).Activate Set vc = Cells.Find(what:=valCherch, lookAt:=xlWhole, After:=ActiveCell, SearchOrder:=xlByColumns, SearchDirection:=xlNext, LookIn:=xlValues, MatchCase:=False, SearchFormat:=False) If Not vc Is Nothing Then cherch = vc.Row End If End Function
Option Explicit Const Parcours = 6 Const Col1 = 1 Const jour = 1 Const pds = 8 Const tps = 9 Const my = 10 Const dn = 11 Private Sub CommandButton1_Click() Dim val_a_trouver As Double, feuille_ou_chercher As Worksheet, feuille_ou_copier As Worksheet Dim colonne_ou_copier As String, mode As String val_a_trouver = 370 Set feuille_ou_chercher = Worksheets("resultats_2011") Set feuille_ou_copier = Worksheets("Faron") colonne_ou_copier = "A" '===================== a toi de choisir ici entre les deux mode (en en mettant un en commentaire mode = "écrasement" 'mode = "à-la-suite" '================================================================================================ If Not extrait_cotes(feuille_ou_chercher, val_a_trouver) Is Nothing Then on_copie extrait_cotes(feuille_ou_chercher, val_a_trouver), feuille_ou_copier, colonne_ou_copier, mode End If End Sub Private Function extrait_cotes(F As Worksheet, V As Double) As Range Dim derniereligne As Long Dim i As Integer derniereligne = F.Cells(Rows.Count, dn).End(xlUp).Row For i = 1 To derniereligne If Cells(i, dn).Value = V Then If extrait_cotes Is Nothing Then Set extrait_cotes = Union(Cells(i, jour), Cells(i, tps), Cells(i, my), Cells(i, pds)) Else Set extrait_cotes = Union(extrait_cotes, Cells(i, jour), Cells(i, tps), Cells(i, my), Cells(i, pds)) End If End If Next i End Function Private Sub on_copie(quoi As Range, F1 As Worksheet, colonne As String, mode As String) Dim desti As Long If mode = "écrasement" Then F1.Cells.ClearContents DoEvents End If desti = F1.Cells(Rows.Count, colonne).End(xlUp).Row + 1 quoi.Copy Destination:=F1.Range(colonne & desti) End Sub
Je souhaite qu'elle cherche une valeur dans la feuille active(resultats_2011), qu'elle copie les valeurs de 4 des cellules de la ligne où cette valeur a été trouvée dans la feuille Faron de ce même fichier.
Oui, je comprends mais je voulais aussi y arriver sans FIND.*
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionil va falloir que tu précises où copier dans ta feuille de destination ! Ce dont tu ne parles même pas !
If .Cells(j, 1).Value = " " Then