Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

15084 / 76734

←次へ　｜　前へ→


	【67133】Re:データの条件付コピー

kanabun - 10/11/7(日) 23:50 -


	引用なし

	パスワード

▼ベニーさん：
おじゃまします

>シート１でＢ列が１の部分だけシート２、Ｂ列が２の部分だけシート３
>というように

フィルタオプションの設定を使って同じ番号(数字)だけ抽出コピー
する方法もありますよ

(前提) 1行目は列見出しとします
(Step 1) A列にどんな番号があるか→リストにしておきます
(Step 2) 番号リスト順に「フィルタオプション」かけて別シートに抽出します

Sub Try1()
　Dim WS2 As Worksheet
　Dim rr As Range, aList As Range, c As Range
　Dim n As Long, nSheet As Long
　
　With Worksheets("Sheet1")
　　Set rr = .Range("A1").CurrentRegion
　　rr.Columns(1).AdvancedFilter xlFilterCopy, , .Range("BB1"), True
　　Set aList = .Range("BB1").CurrentRegion
　End With
　nSheet = 1
　For Each c In Intersect(aList, aList.Offset(1))
　　nSheet = nSheet + 1
　　n = Worksheets.Count
　　If nSheet > n Then
　　　　Set WS2 = Worksheets.Add(After:=Worksheets(n))
　　Else
　　　　Set WS2 = Worksheets(nSheet)
　　　　WS2.UsedRange.ClearContents
　　End If
　　rr.AdvancedFilter xlFilterCopy, aList.Resize(2), WS2.Range("A1")
　　WS2.Name = aList.Item(2).Value　　　　 '抽出した番号をシート名に
　　WS2.Columns.AutoFit　　　　　　　　　　'列幅オートフィット
　　aList.Item(nSheet + 1).Copy aList.Item(2)
　　Set WS2 = Nothing
　Next
　aList.Clear
End Sub

1 hits

▼

【67126】データの条件付コピー ベニー 10/11/7(日) 14:36