任意の列で特定の文字の行をすべてコピーするには

質問

いつもお世話になっております。
Excelで任意の列(R列)に特定の文字("11")の行を全てコピーし、他のブックのシートに貼り付けるにはどのようにすればよいでしょうか。
複数行を一度にコピーして張り付けるという作業がうまくいきません。
できればAutoFilter以外の方法でよろしくお願いします。

回答No.2

ham_kamo · ベストアンサー

No.1です。失礼、「他のブックの」でしたね。
Book2のSheet1にコピーするように修正しました。
Book2という部分とSheet1という部分を適切なものに修正してお使いになれます。なお、Book2は先に開いておく必要があります。

Sub R列が11の行をコピー()
　　Dim r As Range, i As Integer
　　i = 1
　　For Each r In Range("R1", Range("R65536").End(xlUp))
　　　　If r.Value = "11" Then
　　　　　　r.EntireRow.Copy Workbooks("Book2").Worksheets("Sheet1").Cells(i, 1)
　　　　　　i = i + 1
　　　　End If
　　Next
End Sub

回答No.4

KenKen_SP

こんにちは。KenKen_SP です。

もう解決済みかな？

検索範囲が広域だったり、データ数が多い場合は AutoFilter 以外の方法では、
若干複雑なコードになりますが Find を使うと高速ですよ。ご参考までに。

Sub Sample()

　　Dim ShSrc　　　 As Worksheet
　　Dim ShDst　　　 As Worksheet
　　Dim rTable　　　As Range
　　Dim rFound　　　As Range
　　Dim rResult　　 As Range
　　Dim sAddr　　　 As String
　　Dim lDstRowNum　As Long

　　' 元データのシート
　　Set ShSrc = ThisWorkbook.Worksheets("Sheet1")
　　' 貼り付け先シート
　　Set ShDst = Workbooks("Test.xls").Worksheets("Sheet1")

　　On Error Resume Next
　　Set rTable = Intersect(ShSrc.UsedRange, ShSrc.Columns("R"))
　　Set rFound = rTable.Find(What:="11", _
　　　　　　　　　　　　　　 LookIn:=xlValues, _
　　　　　　　　　　　　　　 LookAt:=xlWhole)
　　On Error GoTo 0

　　If Not rFound Is Nothing Then
　　　　' Union を使って全ての見つかったRangeを参照します
　　　　sAddr = rFound.Address
　　　　Do
　　　　　　If rResult Is Nothing Then
　　　　　　　　Set rResult = rFound.EntireRow
　　　　　　Else
　　　　　　　　Set rResult = Union(rResult, rFound.EntireRow)
　　　　　　End If
　　　　　　Set rFound = rTable.FindNext(rFound)
　　　　Loop While Not rFound Is Nothing _
　　　　　　　　　 And rFound.Address <> sAddr
　　　　' 一括でコピー＆貼り付け
　　　　lDstRowNum = ShDst.Cells(Rows.Count, "A").End(xlUp).Row + 1
　　　　rResult.Copy Destination:=ShDst.Rows(lDstRowNum)
　　Else
　　　　MsgBox "該当データはありません", vbInformation
　　End If

End Sub

回答No.3

imogasi

他のブックに、らしいが同一ブックの他のシートの説明にします
R列R2以下
１２
１３
１１
１２
１１
１１
とします。
空き列をS列とします。S１セルは空白にしておいて
ｓ２に=IF(R2=11,MAX($S$1:S1)+1,"")
と入れて下方向に式を複写します。
12
13
11 1
12
11 2
11 3
のようにR列が１１の行にS列で連番を振ります。
この連番数字を新シートの行数順序を表すものだと見て、MATCH関数で別シートの第１、第２、第３行目・・
にR列が空白でない行だけ、値を持ってきます。
わたしの回答の中の「imogasi方式」と出ているものに沢山載せているので、省略しますが、見てください。別ブックの場合は[A.xls]Sheet1!A1のようなセル参照方式を基に、S列の数字参照方式を修正して考えてください。

回答No.1

ham_kamo

マクロでよければ、以下のマクロを、Alt+F11でVBAの画面を出して貼り付けて実行させてみてください。
Sheet2にR列に11が入っている行だけをコピーします。

Sub R列が11の行をコピー()
　　Dim r As Range, i As Integer
　　i = 1
　　For Each r In Range("R1", Range("R65536").End(xlUp))
　　　　If r.Value = "11" Then
　　　　　　r.EntireRow.Copy Worksheets("Sheet2").Cells(i, 1)
　　　　　　i = i + 1
　　　　End If
　　Next
End Sub