|
▼まき さん:
Sub test()
Dim rng As Range, m, k As Long
Set rng = Worksheets("入力用").Columns(1).Cells
For k = Range("B1").Value To Range("B2").Value
m = Application.Match(k, rng, 0)
If IsNumeric(m) Then
Range("A1").Value = k
CopyWithColor rng(m, 2), Range("C3")
CopyWithColor rng(m, 4), Range("D3")
CopyWithColor rng(m, 6), Range("E3")
ActiveSheet.PrintPreview
End If
Next
End Sub
Private Sub CopyWithColor(rngFrom As Range, rngTo As Range)
Dim k As Long
rngTo.Value = rngFrom.Value
' rngTo.Font.Color = rngFrom.Font.Color
For k = 1 To Len(rngTo.Value)
rngTo.Characters(k, 1).Font.Color = rngFrom.Characters(k, 1).Font.Color
Next
End Sub
|
|