| 
    
     |  | こんにちは。かみちゃん です。 
 横から失礼します。
 
 >でオートフィルターをかけて、B13:C17のデータ(実際は14、15、17)を
 >別のシート(シート2)のC6:D6の下の行にかけて“値”の貼り付けさせたいのですが、
 
 「シート1で抽出する行が可変」ということで混乱しましたが、要は、抽出行数は可変だけど、貼り付け先の左上端のセル(C6)で固定ということですよね?
 つまり、貼り付け先の最終行は取得しなていいのではないでしょうか?
 
 ポイントは、オートフィルタで抽出した行は、可視セルのみのコピーをするということです。
 ただし、実際に操作してみるとわかるのですが、先頭行は、項目名として処理されると思いますので、項目名を先頭行につけてください。
 
 スレッドの内容を一通り読ませていただき、実際のセル範囲で書き換えてみると、
 以下のコードでできました。
 
 Sub Macro1()
 Dim FilterSheetName As String
 Dim PasteSheetName As String
 
 '元のシート(AutoFilterで抽出するシート)
 FilterSheetName = ActiveSheet.Name
 '貼り付けシート名
 PasteSheetName = "Sheet2_1"
 
 Sheets(FilterSheetName).Select
 '先頭行を項目名行として、指定したセル範囲AutoFilterする。
 Range("F12:H37").AutoFilter 1, True
 '抽出された行の可視セルのみCopyする。(先頭行はタイトルなので含めない)
 With ActiveSheet.AutoFilter.Range
 .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy
 End With
 
 Sheets(PasteSheetName).Select
 '貼付先の左上端のセルを指定する
 Range("C6").Select
 '値のみ複写
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 
 '元のシートに戻ってAutoFilterの解除
 Sheets(FilterSheetName).Select
 Range("F12:H37").AutoFilter
 Application.CutCopyMode = False
 MsgBox "抽出貼付処理ができました。"
 End Sub
 
 
 |  |