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 38 39
| Option Compare Text
Option Explicit
Public Sub copie_phoenix()
Dim wkl As Worksheet
Dim i As Integer, j As Integer
Dim d As Integer
Dim rcop As Range
Dim lafeuille As Worksheet
Set wkl = Worksheets("Liste")
With wkl
d = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
'balayage des lignes de la feuille Liste
For i = 1 To d
'balayage des 3 colonnes D, E, F de la feuille Liste
For j = 4 To 6
'affectation de la feuille correspondante
Set lafeuille = Worksheets("Tab" & j - 3)
'test valeur
If wkl.Cells(i, j) = "x" Then
With lafeuille
'adresse de la cellule où les données sont recopiées
Set rcop = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
'recopie des valeurs
.Range(rcop, rcop.Offset(0, 5)).Value = wkl.Range(wkl.Cells(i, j).Offset(0, 1 - j), wkl.Cells(i, j).Offset(0, 6 - j)).Value
End With
End If
Set lafeuiile = Nothing
Next j
Next i
Set wkl = Nothing
End Sub |
Partager