データの入力されたシートから、別シートへ値を貼り付ける際に、
貼り付け先のシートの空白セルを探して貼り付けます。
2つのサンプルでは、コピー範囲は4列10行で、そのセル範囲に値が入力されている
かどうかを確認して、全てのセルが空白であったら貼り付けますが、入力されたセルが
あったら範囲をずらして貼り付けます。
【サンプル1】
Sub Sample1()
Dim p_Hanntei As Boolean
Dim my_Cell
Application.ScreenUpdating = False
p_Hanntei = False
Worksheets(1).Activate
Range("A1:D10").Select
Selection.Copy
Worksheets(2).Activate
Range("A1").Select
Do Until p_Hanntei = True
ActiveCell.Offset(0, 0).Range("A1:D10").Select
For Each my_Cell In Selection
If my_Cell.Value = "" Then
p_Hanntei = True
Else
p_Hanntei = False
ActiveCell.Offset(10, 0).Range("A1").Select
Exit For
End If
Next
Loop
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
【サンプル2】
Sub Sample2()
Dim xrw As Integer, flg As Byte
Dim a
Application.ScreenUpdating = False
Do Until flg = 1
xrw = xrw + 1
For Each a In Range(Cells(xrw, 1), Cells(xrw + 9, 4))
If a <> "" Then
flg = 0
Exit For
End If
flg = 1
Next a
Loop
Sheets("sheet1").Select
Range("A1:D10").Copy Sheets("sheet2").Cells(xrw, 1)
Sheets("sheet1").Select
Application.ScreenUpdating = True
End Sub
|