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
| Sub cop()
Dim cible1 As String, cible2 As String
Dim rci As Range, rcic As Integer, lign As Integer, ligngm As Integer
Set Wbdest = ThisWorkbook
Wbdest.Worksheets("P1").Activate
For lign = 25 To 1000
cible1 = ThisWorkbook.Worksheets("P1").Cells(lign, 2).Value
Range(Cells(lign, 1), Cells(lign, 8)).Copy
If IsEmpty(Cells(lign, 1)) Then Exit For
Wbdest.Worksheets("P2").Activate
Set rci = Worksheets("P2").Columns("B:B").Find(What:=cible1, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns).Address
For ligngm = 8 To 1000
If rci = True Then
rcic = rci.Row
ActiveCell = Cells(rcic, 1)
Wbdest.Worksheets("P1").Range(Cells(lign, 1), Cells(lign, 8)).Paste
End If
Next ligngm
Next lign
End Sub |
Partager