|
こんにちは
地道に・・・
Sub test()
Dim t As Range
Dim s As Range
Dim i As Long
On Error Resume Next
Set t = Application.InputBox("コピー元を選択", , , , , , , 8)
If t Is Nothing Then Exit Sub
If t.Columns.Count > 1 Then Exit Sub
Set s = Application.InputBox("貼り付け先を選択", , , , , , , 8)
If s Is Nothing Then Exit Sub
If s.Rows.Count > 1 Then Exit Sub
On Error GoTo 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 1 To t.Rows.Count
s.Cells(1, i).Formula = t.Cells(i, 1).Formula
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Set t = Nothing
Set s = Nothing
End Sub
|
|