必要項目（列）データに絞った抽出貼付で。。

質問

別ブック・シート　（一覧）
日付 - 項目１ - 項目２ - 項目３ - 項目４ - 項目５ - 項目６
↓

上記のフォーマットで日付データ（連続）で並んでいます
これを読み込み、一致する日付データ行でフィルタを掛け、
日付と必要項目（列）データに絞った印刷用シートとして
今開いているブックに作成したいのですが、

当該ブック・シート　(印刷用)
日付 - 項目２ - 項目５ - 項目６
↓
- 　項目２合計 - 項目５合計 - 項目６合計

その際、抽出データ項目の各合計も行末尾に追加したい

---------------------------
インプットボックス入力日付でフィルタを掛けコピーされたデータ
Worksheets("一覧").AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy
この場合、そのまま貼付は　PasteSpecial xlPasteAll　ですが、
必要項目（列）だけ貼付はどのようにすればいいのでしょうか

また、平均３０行ほど抽出になるので印刷シートの抽出項目合計セルは、
３０行以降にSUM関数を埋め込んでおけば問題はありませんか？
（毎日印刷するので上書きが心配です）

最近、行単位での抽出貼付、シート保存を覚えたばかりで、
なんとかそれまでできますが、個別列の抽出貼付で困っています。
SpecialCellsの他に方法はありますか？
ご教示願います。

回答No.1

n-jun

＞この場合、そのまま貼付は　PasteSpecial xlPasteAll　ですが、
＞必要項目（列）だけ貼付はどのようにすればいいのでしょうか

新規Ｂｏｏｋのシート１のセルＡ１～Ｇ５位にオートフィルタが出来そうなデータを並べる。
手動でオートフィルタをかけてみる。
そしたら実行。

Sub try()
Dim r As Range
Dim rr As Range

With Worksheets("Sheet1")
'セルＡ１からつながっているデータ範囲の中で可視セルを取得。
Set r = .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
r.Select
MsgBox r.Address(0, 0)

'上記で取得した範囲のうち、Ｂ・Ｄ・Ｆ列と重なる範囲を取得。
Set rr = Intersect(r, .Range("B1,D1,F2").EntireColumn)
rr.Select
MsgBox rr.Address(0, 0)

'取得した範囲をシート２のＡ１・Ａ２０にコピペする。
r.Copy Worksheets("Sheet2").Range("A1")
rr.Copy Worksheets("Sheet2").Range("A20")
End With

End Sub

例えるのなら、こんな感じでしょうか。

お礼

参考に頑張ってみます！