Sub specialmacro()
Dim rng1 As Range
Dim rng2 As Range
Dim celle1 As Range
Dim celle2 As Range
Dim colm As Long
With Sheets("Sheet1")
Set rng1 = Range(.Cells(12, "Q"), .Cells(.Rows.Count, "Q").End(xlUp))
Set rng2 = Range(.Cells(12, "C"), .Cells(27, "C"))
End With
For Each celle1 In rng1
For Each celle2 In rng2
If celle1 = celle2 Then
colm = Cells(11, "V").Value
celle2.Offset(0, colm) = celle1.Offset(0, 1)
End If
Next celle2
Next celle1
End Sub
|