|
こんにちは
>元CSVより
>行全ての情報がそれぞれのシートに最終的には書き出されますか?
Errのところでデータが無い言う事ですね?
ならおかしいですね?
では確認です。下記のコードの「.Columns(8).AutoFilter 8, C.Value」で
ブレークポイントを設定しコードを実行上記で止まったら「F8」でコードを
進めてオートフィルタで抽出されているかさらに進めてシートのコピーされているかを各シートで確認して下さい。
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
ひとつ気になりました
発言のタグですが初心者さんは「質問」か「発言」になります
「回答」回答される方が使います。
|
|