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
| Option Explicit
Sub Test()
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim DerLig2 As Long, i As Long
Dim MaPlage As Range, Cel As Range
Set Ws1 = Worksheets("Sheet1")
Set Ws2 = Worksheets("Sheet2")
i = 3
With Ws2
DerLig2 = .Range("A" & .Rows.Count).End(xlUp).Row
Set MaPlage = .Range("A3:A" & DerLig2)
For Each Cel In MaPlage
Ws1.Range("A5") = Cel.Value
.Range("B" & i) = Ws1.Range("B5")
.Range("C" & i) = Ws1.Range("C6")
.Range("D" & i) = Ws1.Range("D7")
.Range("E" & i) = Ws1.Range("E8")
.Range("F" & i) = Ws1.Range("F9")
i = i + 1
Next Cel
End With
Set Ws1 = Nothing
Set Ws2 = Nothing
Set MaPlage = Nothing
End Sub |
