Exclのマクロ作成

一番左端の列で文字検索を行い、検索にかかったセルの行全てをコピーし、別シートに貼り付けるマクロを教えてください。検索にかかるセルが複数のときもあります。
よろしくお願いします。

No.2 ベストアンサー 回答者： Wendy02 回答日時： 2005/08/01 18:23

こんにちは。

一番、左端の列という意味が、「A列」のことを指すのでしょうか？ 文字列の一番左を指すのですか？

それによって、多少、コードが変わってきますね。また、コピーの仕方も、上に詰めていくのか、そのままの行で移行すればよいのかも、分かりません。

こちらの思い込みの中で作りました。A列の文字検索をし、その検索でヒットした行全体をコピーし、Sheet2 の上から順にペーストしていく、というものです。

Sub 検索コピー1()
　Dim myFind As String
　Dim r As Range, Faddr As String, i As Long
　Dim CopySh As Worksheet
　'============設定===================
　Set CopySh = Worksheets("Sheet2") 'コピー先シート
　'============設定終了================
　
　myFind = Application.InputBox("検索値を入力してください。", Type:=2)
　If VarType(myFind) = vbBoolean Or myFind = "" Then Exit Sub
　Set r = Columns(1).Find(What:=myFind, _
　　　　　　　　　　　　　LookIn:=xlValues, _
　　　　　　　　　　　　　LookAt:=xlWhole, _
　　　　　　　　　　　　　SearchOrder:=xlByColumns)
　If Not r Is Nothing Then
　　Faddr = r.Address
　　Do
　　　i = i + 1
　　　r.EntireRow.Copy CopySh.Cells(i, 1)
　　　Set r = Columns(1).FindNext(r)
　　Loop Until r Is Nothing Or Faddr = r.Address
　End If
　If i > 0 Then
　　MsgBox i & "行コピーしました。", vbInformation
　End If
End Sub

この回答へのお礼

丁寧な回答ありがとうございました。

お礼日時：2005/08/02 13:43

No.3 回答者： komet163 回答日時： 2005/08/02 09:52

こんにちは。

「一番左端の列」が A列として、また一番上の行がタイトル行とします。
タイトル行が無い場合、１行目に行挿入して適当にタイトルを付けてください。
例）
A1 には "検索項目"
B1 には "付随項目"
C1 には ・・・ 以下同様

以下は、上記フォーマットのアクティブシートのデータベース範囲を
検索文字でフィルタ抽出し、可視セルの全てを[結果]シートに張っています。

Const SearchText = "検索文字列"
With Range("A1")
.AutoFilter Field:=1, Criteria1:="=*" & SearchText & "*"
.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
With Worksheets("結果")
.Paste .Range("A1")
End With
End With
Application.CutCopyMode = False
ActiveSheet.AutoFilterMode = False

データベース範囲が対象なので、データ途中に空白行があったりすると、
その行で検索が中断されます。ご注意ください。

No.1 回答者： merlionXX 回答日時： 2005/08/01 17:26

A1～100の各セルのデータに「AAAA」という文字があったら、そのセルのある行のデータをSheet2のA列に転記するマクロです。

Sub test()
Dim i As Integer, n As Integer
n = 1
For i = 1 To 100
If InStr(Cells(i, "A"), "AAAA") Then
Sheets("Sheet2").Rows(n).Value = ActiveSheet.Rows(i).Value
n = n + 1
End If
Next
End Sub