Excel VBA質問箱 IV

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

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


57507 / 76738 ←次へ | 前へ→

【23967】オートフィル抽出後のコピー範囲指定
質問  asedaku  - 05/4/8(金) 18:37 -

引用なし
パスワード
   初めまして、ExcelBVA初心者です。
40過ぎの独学にて行き詰まっております。
質問事項の記述方法もよく分からないまま質問させて頂きます。
どなたかご教授頂けませんでしょうか?

- 作業の流れ -
 "元データ"シートと"日誌"シートの2つのシートがあります。
 "元データ"シートには一ヶ月のデータが行方向に入り、
 "日誌"シートには"元データ"から必要日のデータをオートフィルで抽出して、
 必要な列(必要な列は連続しています)の範囲を指定した後に、"日誌シート"に
 「値」だけを貼り付ける(貼り付け開始位置は固定)というものです。

- 質問事項 -
 "元データ"シートには1列から35列まであります。
 行数は日によって違います。
 そのうち1.2.3.4列には年・月・日・曜日が入力されておりますが、
 貼り付け先の日誌にはすでに年月日のタイトルがあるため不要となります。
 また、34.35列のデータも日誌には必要の無いものです。
 日誌には29列分の貼り付け範囲しかありません。
 長くなりましたが、"元データ"シートのコピーの範囲指定に必要な列は5〜33列
 ということになります。

 質問箱で皆さんの質問と回答を参考にさせて頂き、
 下記のコードにて必要な行数のコピーはできたのですが、
 このコードだと1〜35列まで全ての列がコピーされてしまいます。
 なんとか"元データ"シートの必要な列、5〜33列を範囲指定して、
 "日誌"シートのCells(36, 1)への貼り付けはできないものでしょうか?
 よろしくお願いします。
 不規則な勤務をしておりますので、お返事が遅れることをお許し下さい。
 
Private Sub CommandButton5_Click()

  '元のシート(AutoFilterで抽出するシート)
  Worksheets("元データ").Select
  '先頭行を項目名行として、指定したセル範囲AutoFilterする。
  Dim a As Variant
    a = InputBox("半角数字で入力してください!", "絞り込みの日を入力し
           て下さい!", a)
  Selection.AutoFilter Field:=3, Criteria1:=a
  '抽出された行の可視セルのみCopyする。(先頭行はタイトルなので含めない)
  With ActiveSheet.AutoFilter.Range _
   .Resize(Rows.Count - 1).Offset(1).SpecialCells _
   (xlCellTypeVisible).Copy
  End With
 
  '貼り付けシート名
  Worksheets("日誌").Select
  '貼付先の左上端のセルを指定する
  Worksheets("日誌").Cells(36, 1).Select
  '値のみ複写
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
  SkipBlanks:=False, Transpose:=False
  
  'AutoFilterの解除
  Worksheets("元データ").Select
  Selection.AutoFilter Field:=3
  
End Sub

0 hits

【23967】オートフィル抽出後のコピー範囲指定 asedaku 05/4/8(金) 18:37 質問
【23974】Re:オートフィル抽出後のコピー範囲指定 ウッシ 05/4/8(金) 20:58 回答
【23976】Re:オートフィル抽出後のコピー範囲指定 asedaku 05/4/8(金) 22:39 お礼
【23978】Re:オートフィル抽出後のコピー範囲指定 ウッシ 05/4/8(金) 22:44 回答
【23980】Re:オートフィル抽出後のコピー範囲指定 asedaku 05/4/8(金) 23:01 お礼

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