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
| Sub RecopieCellule()
Dim p
Dim nbligne As Integer
Dim numligne As Integer
Dim numlignedest As Integer
Dim priorité As Range
Set priorité = Worksheets("origine").Range("A1:A100")
nbligne = WorksheetFunction.Max(priorité)
numlignedest = 8
Sheets("origine").Activate
For p = 1 To nbligne
priorité.Cells.Find(What:=p, LookIn:=xlValues).Activate
numligne = ActiveCell.Row
With Sheets("origine")
Sheets("destination").Cells(numlignedest, 4).Value = ActiveCell.Offset(0, 1).Value
Sheets("destination").Range(Cells(numlignedest, 1), Cells(numlignedest, 3)).Value = .Range(Cells(numligne, 6), Cells(numligne, 8)).Value
Sheets("destination").Range(Cells(numlignedest, 5), Cells(numlignedest, 7)).Value = .Range(Cells(numligne, 10), Cells(numligne, 12)).Value
numlignedest = numlignedest + 1
End With
Next
End Sub |
Partager