| 
    
     |  | kein さん ありがとうございます、助かりました。
 色々と手を加えて、出来るようになったのですが、
 解決できない事が1つあるのです。
 大変恐縮なのですが、先頭行が10行以上でそれ以下の行にデ−タがあるセル、ないセル(空白)が不特定の場合、どの様に処理をすればよろしいでしょうか?
 お忙しいとは思いますが、教えて頂きたいのですが。
 
 >Sub Data_Move()
 >  Dim x As Long, y As Long, z As Long
 >
 >  If TypeName(Selection) <> "Range" Then Exit Sub
 >  'もし選択対象がセルでなかったら中止
 >
 >  With Selection
 >   If .Columns.Count > 1 Then Exit Sub
 >   'もし選択範囲の列数が2列以上なら中止
 >
 >   x = .Column: y = .Rows.Count: z = .Row
 >   'xは列番号、yは行数、zは先頭行の番号
 >
 >   If z < 11 Then Exit Sub
 >   'もし先頭行が10以下なら中止
 >
 >   If x Mod 2 = 0 Then Exit Sub
 >   'もし列番号が偶数なら中止
 >
 >   If x >= Cells(256).End(xlToLeft).Column Then Exit Sub
 >   'もし列番号がデータ入力範囲の最終列以上なら中止
 >
 >   If WorksheetFunction.CountA(Selection) < .Cells.Count Then
 >   'もし選択範囲に空白セルがあったら
 >
 >     Exit Sub
 >    '中止
 >   End If
 >   Application.ScreenUpdating = False
 >   .Delete xlShiftUp
 >  End With
 >  With Cells(z, x + 1).Resize(y)
 >   .Copy Cells(65536, x).End(xlUp).Offset(1)
 >   .Delete xlShiftUp
 >  End With
 >  Application.ScreenUpdating = True
 >End Sub
 
 |  |