Excel VBA質問箱 IV

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

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


9824 / 76734 ←次へ | 前へ→

【72467】Re:転記したい
発言  UO3  - 12/8/13(月) 17:36 -

引用なし
パスワード
   ▼うさこ さん:

フィルターオプション版もアップしておきますね。

Sub Sample3()  'フィルタ−オプション
  Dim yy As Long
  Dim mm As Long
  Dim t1 As Variant
  Dim t2 As Variant
  Dim t3 As Variant
  
  Application.ScreenUpdating = False
  
  yy = 2012
  mm = 7

  With Sheets("Sheet1")
    .Range("N1:O1").Value = .Range("A1").Value
    .Range("N2").Value = ">=" & CDbl(DateSerial(yy, mm, 1))
    .Range("O2").Value = "<" & CDbl(DateSerial(yy, mm + 1, 1))
    t1 = .Range("A1:B1").Value
    t2 = .Range("C1:G1").Value
    t3 = .Range("H1:L1").Value
  End With
  
  With Sheets("Sheet2")
    .UsedRange.ClearContents
    .Range("A1:B1").Value = t1
    .Range("C1:G1").Value = t2
    Sheets("Sheet1").Columns("A:L").AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=Sheets("Sheet1").Range("N1:O2"), CopyToRange:=.Range("A1:G1") _
      , Unique:=False
  End With
  
  With Sheets("Sheet3")
    .UsedRange.ClearContents
    .Range("A1:B1").Value = t1
    .Range("C1:G1").Value = t3
    Sheets("Sheet1").Columns("A:L").AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=Sheets("Sheet1").Range("N1:O2"), CopyToRange:=.Range("A1:G1") _
      , Unique:=False
  End With
  
  Sheets("Sheet1").Range("N1:O2").Clear
  
  Application.ScreenUpdating = True
  
End Sub

6 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 お礼

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