Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


62194 / 76732 ←次へ | 前へ→

【19146】Re:データの複写
回答  かみちゃん  - 04/10/23(土) 11:33 -

引用なし
パスワード
   こんにちは。かみちゃん です。

横から失礼します。

>でオートフィルターをかけて、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
0 hits

【19136】データの複写 kuyacchi 04/10/22(金) 23:36 質問
【19137】Re:データの複写 チーコ 04/10/22(金) 23:58 回答
【19138】Re:データの複写 kuyacchi 04/10/23(土) 0:23 質問
【19139】Re:データの複写 kuyacchi 04/10/23(土) 0:26 質問
【19141】Re:データの複写 チーコ 04/10/23(土) 0:45 回答
【19144】Re:データの複写 kuyacchi 04/10/23(土) 10:19 質問
【19147】Re:データの複写 チーコ 04/10/23(土) 11:37 回答
【19146】Re:データの複写 かみちゃん 04/10/23(土) 11:33 回答
【19149】Re:データの複写 kuyacchi 04/10/23(土) 12:09 お礼
【19150】Re:データの複写 かみちゃん 04/10/23(土) 13:37 発言
【19151】Re:データの複写 kuyacchi 04/10/23(土) 14:08 お礼
【19152】Re:データの複写 かみちゃん 04/10/23(土) 15:41 回答
【19154】Re:データの複写 kuyacchi 04/10/23(土) 20:29 お礼

62194 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free