Excel VBA質問箱 IV

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

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


9823 / 76734 ←次へ | 前へ→

【72468】Re:転記したい
発言  kanabun  - 12/8/13(月) 17:50 -

引用なし
パスワード
   ▼うさこ さん:
おじゃまします。
こういうのは、ぼくなら(ぼくも)フィルタオプションでやります
UO3 さんがすでにサンプルコードを投稿されてますが、
同じではないと思うので、こちらの例を

Sub Try1()
  Dim WS1 As Worksheet
  Dim WS2 As Worksheet
  Dim WS3 As Worksheet
  
  Set WS1 = Workbooks("転記元Book.xls").Worksheets("Sheet1") '【要変更】
  Set WS2 = Workbooks("転記先Book.xls").Worksheets("Sheet1")'【要変更】
  Set WS3 = Workbooks("転記先Book.xls").Worksheets("Sheet2")'【要変更】
  
  'WS1のQ列に抽出条件を書き込む
  Dim CrRange As Range
  Set CrRange = WS1.[Q1:Q2]
  With CrRange
    .ClearContents
    .Item(2).Formula = "=MONTH(A2)=7" '[Q2]に 7月の行を抽出式
  End With
  '抽出先に 転記したい項目をコピー (Sheet1の方)
  Dim CopyTo As Range
  Set CopyTo = WS2.[A1].Resize(, 7)
  With WS1.[A1]
    .Resize(, 7).Copy CopyTo
    .CurrentRegion.AdvancedFilter xlFilterCopy, CrRange, CopyTo
  End With
  
  '抽出先に 転記したい項目をコピー (Sheet2の方)
  Set CopyTo = WS3.[A1].Resize(, 6)
  WS3.[A1].Value = WS1.[A1].Value
  WS1.[H1].Resize(, 5).Copy WS3.[B1]
  WS1.[A1].CurrentRegion.AdvancedFilter xlFilterCopy, CrRange, CopyTo
  
End Sub

4 hits

【72452】転記したい うさこ 12/8/13(月) 12:01 質問
【72454】Re:転記したい UO3 12/8/13(月) 14:08 発言
【72455】Re:転記したい うさこ 12/8/13(月) 14:13 質問
【72456】Re:転記したい UO3 12/8/13(月) 14:27 発言
【72457】Re:転記したい UO3 12/8/13(月) 14:29 発言
【72458】Re:転記したい うさこ 12/8/13(月) 14:57 質問
【72461】Re:転記したい うさこ 12/8/13(月) 16:36 質問
【72462】Re:転記したい Yuki 12/8/13(月) 16:51 発言
【72465】Re:転記したい UO3 12/8/13(月) 17:19 発言
【72467】Re:転記したい UO3 12/8/13(月) 17:36 発言
【72468】Re:転記したい kanabun 12/8/13(月) 17:50 発言
【72469】Re:転記したい うさこ 12/8/13(月) 18:31 お礼

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