|
▼Hirofumi さん:
長すぎて途中でカットしています。
この場合は分割しても最後まで載せたほうがいいですか?
ただ、このプログラムの"Sheet1"を全て他のシート名に変更したいのです。
よろしくお願いします。
Sub 間取わけ()
Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:="ワンルーム"
Cells.Select
Selection.Copy
Sheets("ワンルーム").Select
Cells.Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Selection.AutoFilter Field:=9
Selection.AutoFilter Field:=8, Criteria1:="1"
Application.CutCopyMode = False
Selection.Copy
Sheets("1部屋").Select
Cells.Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Selection.AutoFilter Field:=8, Criteria1:="2"
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("2部屋").Select
Cells.Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Selection.AutoFilter Field:=8, Criteria1:="3"
Application.CutCopyMode = False
Selection.Copy
Sheets("3部屋").Select
Cells.Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Selection.CurrentRegion.Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.AutoFilter
Sheets("Sheet1").Select
Selection.AutoFilter Field:=8, Criteria1:="2"
Cells.Select
Selection.CurrentRegion.Select
Selection.EntireRow.Delete
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:="ワンルーム"
Cells.Select
Selection.CurrentRegion.Select
Selection.EntireRow.Delete
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.AutoFilter
Selection.AutoFilter Field:=8, Criteria1:="1"
Cells.Select
Selection.CurrentRegion.Select
Selection.EntireRow.Delete
Cells.Select
Selection.Copy
Sheets("4部屋").Select
Cells.Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Sheets("4部屋").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
Cells.Select
Range("N1").Activate
Selection.Sort Key1:=Range("V1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Sheets("3部屋").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Sheets("2部屋").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Sheets("1部屋").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Sheets("1部屋").Select
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:="1LDK"
Cells.Select
Selection.Copy
Sheets("1LDK").Select
Cells.Select
ActiveSheet.Paste
Sheets("1部屋").Select
Selection.CurrentRegion.Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
Cells.Select
Selection.Sort Key1:=Range("V1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Sheets("1LDK").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Sheets("ワンルーム").Select
Selection.Sort Key1:=Range("V2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Rows("1:1").Select
Selection.Copy
|
|