|
条件を下記として、コードを書いてみました
コピー元をA1
貼り付け位置を B1とし、同じシート上にある。
対象シートを、現在表示している。
数式が入力されていてもコピーしない。(=""が入力されていてもコピーしない)
Option Explicit
Private Sub myCopy()
Dim mySheet As Worksheet
'対象セルを含むシート、
’ただし、コピー元と貼り付け先が同じシートに含まれる。
Dim buf As Variant '一時保持 貼り付け先の値
Dim i As Long '繰り返し用
'現在のシートを取得する
Set mySheet = ActiveSheet
'コピー元のデータを取得する
mySheet.Range("A1").Copy
'コピー先を選択する。
mySheet.Range("B1").Select
'繰り返しによって、空白セルを探す
For i = 1 To 100
'無限ループ回避のため、forを用いています。Doを利用してもいいです。
buf = Selection.Value '値の取得
If TypeName(buf) = "Empty" Then '空白かの確認
mySheet.Paste Destination:=Selection '貼り付け
Exit For 'ループを抜ける
End If
Selection.Offset(1, 0).Select
'空白の場合、ひとつ下を選択する
Next i
End Sub
|
|