|
では、こんな感じで・・
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
x = .Column: y = .Rows.Count: z = .Row
If z < 11 Then Exit Sub
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
|
|