copie de cellules adjacentes

[recovery]

Bonjour,

Encore une fois je viens demander de l'aide aux initiés.
Voici mon problème j'ai créé une macro pour rechercher une variable dans ma base de donnée une fois cette dernière trouvée je la copie dans une autre feuille aucun problème pour l'instant là ou ça se complique c'est que j'aimerais aussi copier les quatre autres cellules qui se trouve à gauche de celle-ci, j'ai bidouiller du code mais rien à faire AU SECOURS
A toute fin utile voici le code:
Sub copie()
Dim MonDELingne As Integer
Dim valeur As String
Sheets("Feuil1").Select
Range("f2").Select
MonDELingne = Range("f50000").End(xlUp).Row
'MonDeLigne1 = Range("a50000").End(xlUp).Select

Do
valeur = ActiveCell.Value
If ActiveCell.Value = "intervenant 10" Then
Sheets("Requetes").Select
Range("a50000").End(xlUp).Select
ActiveCell.Offset(1, 0).Value = valeur
Exit Do
End If
ActiveCell.Offset(1, 0).Select
Loop While ActiveCell.Row < MonDELingne + 1

End Sub

Merci.

 

[kjin]

Re : copie de cellules adjacentes

Bonjour,
Comme tu n'indiques pas si une simple copie suffirait...

Sub copie()
Dim v$, c As Range, rng As Range, dl&
v = "intervenant 10"
With Sheets("Feuil1")
    Set c = .Range("F:F").Find(v)
    If Not c Is Nothing Then
        Set rng = .Range(c, c.Offset(0, 4))
        With Sheets("Requêtes")
            dl = .Range("A65000").End(xlUp).Row + 1
            .Range(.Cells(dl, 1), .Cells(dl, 5)) = rng.Value
        End With
    End If
End With
End Sub

A+
kjin

 

[job75]

Re : copie de cellules adjacentes

Bonjour recovery, salut kjin 🙂

Quelle galère tous ces Select, alors que c'est parfaitement inutile en VBA...

Une autre manière :

Sub Copie()
Dim lig As Variant, plage As Range
On Error Resume Next 'si la valeur n'est pas trouvée
With Sheets("Feuil1")
  lig = Application.Match("intervenant 10", .[f2:f50000], 0)
  Set plage = .[b1:f1].Offset(lig)
End With
With Sheets("Requetes").Range("a50000").End(xlUp)
  .Offset(1).Resize(, 5) = plage.Value ' copie uniquement les valeurs
  'plage.Copy .Offset(1) 'copie tout
  'Application.Goto .Offset(1).Resize(, 5) 'si l'on veut absolument sélectionner...
End With
End Sub

A+

 

[recovery]

Re : copie de cellules adjacentes

Bonjour,
Comme tu n'indiques pas si une simple copie suffirait...

Sub copie()
Dim v$, c As Range, rng As Range, dl&
v = "intervenant 10"
With Sheets("Feuil1")
    Set c = .Range("F:F").Find(v)
    If Not c Is Nothing Then
        Set rng = .Range(c, c.Offset(0, 4))
        With Sheets("Requêtes")
            dl = .Range("A65000").End(xlUp).Row + 1
            .Range(.Cells(dl, 1), .Cells(dl, 5)) = rng.Value
        End With
    End If
End With
End Sub

A+
kjin

mille merci Kjin
Encore une fois en quelques minutes j'ai été dépanné formidable dés lors que l'on maitrise parfaitement le vba néanmoins dans la mesure du possible pourrais tu me détailler la syntaxe utilisée de manière à bien assimiler cette dernière.

merci pour ta disponibilité

Cordialement. Recovery

 

[recovery]

Re : copie de cellules adjacentes

Bonjour recovery, salut kjin 🙂

Quelle galère tous ces Select, alors que c'est parfaitement inutile en VBA...

Une autre manière :

Sub Copie()
Dim lig As Variant, plage As Range
On Error Resume Next 'si la valeur n'est pas trouvée
With Sheets("Feuil1")
  lig = Application.Match("intervenant 10", .[f2:f50000], 0)
  Set plage = .[b1:f1].Offset(lig)
End With
With Sheets("Requetes").Range("a50000").End(xlUp)
  .Offset(1).Resize(, 5) = plage.Value ' copie uniquement les valeurs
  'plage.Copy .Offset(1) 'copie tout
  'Application.Goto .Offset(1).Resize(, 5) 'si l'on veut absolument sélectionner...
End With
End Sub

A+

OK JOB75
j'essaie ta syntaxe je te tiens au courant

Merci à toi aussi pour ta disponibilité.