Excel VBA質問箱 IV

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

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


1559 / 13645 ツリー ←次へ | 前へ→

【73491】オートフィルタのリスト毎に別シートにコピー とま 13/1/15(火) 16:31 質問[未読]
【73493】Re:オートフィルタのリスト毎に別シートに... n 13/1/15(火) 23:20 発言[未読]
【73531】Re:オートフィルタのリスト毎に別シートに... とま 13/1/18(金) 17:07 お礼[未読]

【73491】オートフィルタのリスト毎に別シートにコ...
質問  とま  - 13/1/15(火) 16:31 -

引用なし
パスワード
   Sheet1にはA列からG列までデータ入力されています。
やりたいことはオートフィルタを利用し、D列のリストを取得し
そのリスト毎のデータを同じブック内の新しいシートにコピーをしていく。
コピーする際は、そのリストと同じシート名にしたいという事を
実現したいのですが、途中まで作成しましたがうまくいきません。
どなたかお知恵をお貸しください。


Sub Test()

Dim ws As Worksheet, r As Range
Dim myList As New Collection


On Error Resume Next

Set ws = ActiveSheet

With ws

  For Each r In .Range(.Range("D2"), .Range("D65536").End(xlUp))
    myList.Add r.Value, CStr(r.Value)
  Next r
 
  .Range("A1").AutoFilter
  If Not .AutoFilterMode Then .Range("A1").AutoFilter
 
  For i = 1 To myList.Count

    Set ws = Worksheets.Add(xlWBATWorksheet)
    Sheets(Sheet1).Select
   
    .Range("A1").AutoFilter field:=4, Criteria1:=myList(i)
    .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
           Destination:=wb.Worksheets(1).Range("A1")

  Next i
  
 
  .Range("A1").AutoFilter

End With

Set myList = Nothing

End Sub

【73493】Re:オートフィルタのリスト毎に別シート...
発言  n  - 13/1/15(火) 23:20 -

引用なし
パスワード
   AdvancedFilterメソッドを使って作業列にユニーク値を取り出し、それをLoopしてはどうでしょうか。

Dim ws As Worksheet
Dim rs As Range
Dim r As Range

Set ws = ActiveSheet
ws.AutoFilterMode = False
If ws.Range("D65536").End(xlUp).Row = 1 Then Exit Sub

Set rs = ws.Range("A1").CurrentRegion
rs.Columns("D").AdvancedFilter Action:=xlFilterCopy, _
                CopyToRange:=ws.Range("IV1"), _
                Unique:=True
For Each r In ws.Range("IV2", ws.Range("IV65536").End(xlUp))
  With Worksheets.Add(Sheets(1))
    rs.AutoFilter field:=4, Criteria1:=r.Value
    rs.Copy Destination:=.Range("A1")
    On Error Resume Next
    .Name = r.Value
    On Error GoTo 0
  End With
Next
ws.AutoFilterMode = False
ws.Columns("IV").Delete

【73531】Re:オートフィルタのリスト毎に別シート...
お礼  とま  - 13/1/18(金) 17:07 -

引用なし
パスワード
   できました。
本当にありがとうございました。

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