| |
こんにちは。かみちゃん です。
本当は、へるぴーさんがまずは「マクロの記録」を使って、どこまでできているの
かを見せていただきたかったのですが、りすりすさんからコードの提示がありまし
たので、それを元に私ならこうするというコードを提示しておきます。
コード中の変数名やメッセージなど、りすりすさん提示のコードをベースにさせて
いただいています。
ただ、CopyではなくCutでは？（「切り取り」と言っているので・・・）
「貼り付け先は上から見て」とは、「どの列の上から見て」かもはっきりしていませんが・・・
Option Explicit
Sub test()
Dim SourceSheet, DestSheet As Worksheet
Dim c As Range
Dim Text As String
Text = InputBox("もしもし")
Set SourceSheet = Sheets("Sheet1") ' 探すシートを指定
Set DestSheet = Sheets("Sheet2") ' 貼り付け先のシート
' ↓ここの列(A)で検索
Set c = SourceSheet.Columns(1).Cells. _
Find(What:=Text, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
If Not c Is Nothing Then
'該当データ（つまりその行（見つかったセルを含む行）丸ごと）を切り取る。
Rows(c.Row).Cut
'貼り付け先シートを選択
DestSheet.Select
'貼り付け先は上からみて、最初の空白行の１行上
'（上から見て連続してデータの入っている最下端）
'のセルがExcelの最大行より小さい場合
'貼り付け先の上とは、ここでは、A列のことをさしているものとする。
If Range("A1").End(xlDown).Row < Columns(1).Rows.Count Then
'貼り付ける
Range("A1").End(xlDown).Offset(1).Select
ActiveSheet.Paste
Else
'Excelの最大行だった場合は、空白行はないのでエラーとする。
MsgBox "もういっぱいで書き込めないや(-.-) "
End If
'探すシートに戻す
SourceSheet.Select
Application.CutCopyMode = False
Else
'該当データが見つからなかった場合
MsgBox "そんなのないよん"
End If
End Sub
|
|
かみちゃん
- 05/2/3(木) 7:01 -
