Excel VBA質問箱 IV

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

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


15081 / 76734 ←次へ | 前へ→

【67136】Re:データの条件付コピー
発言  kanabun  - 10/11/8(月) 9:20 -

引用なし
パスワード
   ▼ベニー さん:

少し修正しました

Sub Try2()
 Dim WS2 As Worksheet
 Dim rr As Range, aList As Range, c As Range
 Dim n As Long, nSheet As Long
 
 With Worksheets("Sheet1")  'A列の一意な番号リストを作成(範囲aList)
  Set rr = .Range("A1").CurrentRegion
  rr.Columns(1).AdvancedFilter xlFilterCopy, , .Range("BB1"), True
  Set aList = .Range("BB1").CurrentRegion
 End With
 
 For nSheet = 2 To aList.Count
  n = Worksheets.Count
  If nSheet > n Then        'シートがないとき
    Set WS2 = Worksheets.Add(After:=Worksheets(n))
  Else
    Set WS2 = Worksheets(nSheet) 'シートがあるとき
    WS2.UsedRange.ClearContents
  End If              '抽出Copy
  rr.AdvancedFilter xlFilterCopy, aList.Resize(2), WS2.Range("A1")
  WS2.Name = aList.Item(2).Value  '抽出した番号をSheet名に
  WS2.Columns.AutoFit        '列幅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 発言

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