| |
▼Statis さん：
>こんにちは
>
>
>下記のコードを新規ファイルに記載して下さい。
>
>コードを実行すると「csv」ファイルの選択になりますので該当ファイルを
>探し選択して下さい。
>新規ファイルが自動的に出来、そのファイルにＨ列の各値のシートが出来て
>オートフィルタで抽出したデータがコピーされ並び替え、列の削除を行います。
>
>一度試してみて下さい。（結果を報告願います）
>
>Sub Test()
>Dim MyFil As String, Wb As Workbook, Ws As Worksheet
>Dim NowWb As Workbook, NowWs As Worksheet, C As Range
>
>MyFil = Application.GetOpenFilename("テキスト ファイル (*.csv), *.csv")
>If MyFil = "False" Then Exit Sub
>Application.ScreenUpdating = False
>Set Ws = ThisWorkbook.Worksheets("Sheet1")
>Set NowWb = Workbooks.Add(1)
>Set Wb = Workbooks.Open(MyFil)
>With Wb.ActiveSheet
> .Columns(8).AdvancedFilter xlFilterCopy, , Ws.Range("A1"), True
> .Rows(1).AutoFilter
> For Each C In Ws.Range("A2", Ws.Range("A65536").End(xlUp))
> .Columns(8).AutoFilter 8, C.Value
> Set NowWs = NowWb.Worksheets.Add
> NowWs.Name = C.Value
> .AutoFilter.Range.Copy NowWs.Range("A1")
> With NowWs
> .Rows(1).Delete
> .UsedRange.Sort Key1:=.Range("A1"), Order1:=xlAscending, Key2:=.Range("B1") _
> , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
> False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _
> xlSortNormal, DataOption2:=xlSortTextAsNumbers
> .Columns("A:B").Delete
> .Cells.EntireColumn.AutoFit
> End With
> Set NowWs = Nothing
> Next C
> .AutoFilterMode = False
>End With
>Ws.Columns(1).Clear
>Wb.Close False
>With Application
> .DisplayAlerts = False
> NowWb.Sheets("Sheet1").Delete
> .DisplayAlerts = True
> .ScreenUpdating = True
>End With
>Set NowWb = Nothing: Set Ws = Nothing: Set Wb = Nothing
>End Sub
有難う御座います
ただ それぞれに 既にシート名が振ってあるため
Set Ws = ThisWorkbook.Worksheets("Sheet1")
上記で止まってしまいます。。
|
|
初心者
- 06/5/31(水) 11:18 -
