エクセルVBA キーワード行を転記

お世話になります。

下記、VBAコードは、データが入力されているA列からキーワード
が含まれている行を隣りのシートに転記するというものです。
（ググって見つけました。私の作ではありません。）

Sub キーワードの行を転記()
Dim lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.Clear
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
With .Rows(1 & ":" & lastRow)
.AutoFilter field:=1, Criteria1:="*郡*", Operator:=xlOr
.SpecialCells(xlCellTypeVisible).Copy
wS.Activate
ActiveSheet.Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
End With
.AutoFilterMode = False
Application.CutCopyMode = False
End With
End Sub

”郡” が含まれる行だけでいいのですが、
A1セルも必ず転記されてしまいます。
直していただけないでしょうか。

No.1 回答者： tom04 回答日時： 2017/05/26 21:27

こんばんは！

Sheet1の1行目は項目行になっているのですよね？
すなわち項目行を除いて2行目以降をSheet2の1行目以降にコピー＆ペーストしたい！という解釈です。
一例です。
標準モジュールにしてください。

Sub Sample1()
Dim lastRow As Long, lastCol As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.Clear
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range("A1").AutoFilter field:=1, Criteria1:="*郡*"
If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
Range(.Cells(2, "A"), .Cells(lastRow, lastCol)).SpecialCells(xlCellTypeVisible).Copy wS.Range("A1")
End If
.AutoFilterMode = False
End With
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

tom04さん

早速のご教示、ありがとうございます。
実行しましたが、オートフィルターが機能
しませんでした。

お礼日時：2017/05/27 10:11