Excel VBA質問箱 IV

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

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


15088 / 76738 ←次へ | 前へ→

【67133】Re:データの条件付コピー
発言  kanabun  - 10/11/7(日) 23:50 -

引用なし
パスワード
   ▼ベニー さん:
おじゃまします

>シート1でB列が1の部分だけシート2、B列が2の部分だけシート3
>というように

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

(前提) 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

0 hits

【67126】データの条件付コピー ベニー 10/11/7(日) 14:36 質問
【67129】Re:データの条件付コピー Hirofumi 10/11/7(日) 16:26 発言
【67130】Re:データの条件付コピー Hirofumi 10/11/7(日) 16:47 回答
【67131】Re:データの条件付コピー Hirofumi 10/11/7(日) 16:48 回答
【67133】Re:データの条件付コピー kanabun 10/11/7(日) 23:50 発言
【67136】Re:データの条件付コピー kanabun 10/11/8(月) 9:20 発言

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