空白セルを探して値を貼り付ける
 データの入力されたシートから、別シートへ値を貼り付ける際に、
貼り付け先のシートの空白セルを探して貼り付けます。

 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

Excel97/2000



戻る


Excel Word Access VBA! モーグ