copie de cellules adjacentes

kjin à dit:

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

Code:

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

Cliquez pour agrandir...

job75 à dit:

Bonjour recovery, salut kjin 🙂

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

Une autre manière :

Code:

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+

Cliquez pour agrandir...