| |
▼栗きんとん さん：
こんにちは〜
>先頭文字がJan 〜 Decから始まるものA列を検索。
ということは、セルの値が
Jan*
Feb*
Mar*
Apr*
May*
Jun*
Jul*
Aug*
Sep*
Oct*
Nov*
Dec*
で始まっているセルだけをCopyしたいってことですよね？
>一致した行をコピーして××シートのA列へ貼り付け繰り返す。
フィルタオプションの設定（Excel2007以降ではフィルタ -「詳細設定」のことです）を
つかわれたらどうでしょう。これなら、Loopする必要ないですし、Jan*〜 Dec* まで
一括抽出できますよ
Sub Try1()
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim r As Range
Dim c As Range
Set WS1 = Worksheets(1) 'コピー元シート
Set WS2 = Worksheets(2) 'コピー先シート
With WS2
'[AA列]に抽出条件記入 列は空いている列ならどこでもよい
Set c = .Range("AA1").Resize(13)
c.Value = [{"wkHeader";"Jan*";"Feb*";"Mar*";"Apr*";"May*";"Jun*";"Jul*";"Aug*";"Sep*";"Oct*";"Nov*";"Dec*"}]
End With
Application.CutCopyMode = True
With WS1
.Rows(1).Insert '１行挿入
.Range("A1").Value = "wkHeader" '作業用に列見出しを書き込む
Set r = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
r.AdvancedFilter xlFilterInPlace, c ’フィルタオプション実行
If r.SpecialCells(xlVisible).Count > 1 Then '１行以上抽出行があったとき
Intersect(r, r.Offset(1)).Copy WS2.[A1] '所定シートへコピー
End If
.ShowAllData
.Rows(1).Delete
End With
End Sub
|
|
kanabun
- 11/12/20(火) 20:54 -
