| 
    
     |  | 条件を下記として、コードを書いてみました コピー元を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
 
 |  |