| |
▼うさこ さん：
おじゃまします。
こういうのは、ぼくなら(ぼくも)フィルタオプションでやります
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
|
|
kanabun
- 12/8/13(月) 17:50 -
