| 
    
     |  | こんにちは >元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
 
 
 ひとつ気になりました
 発言のタグですが初心者さんは「質問」か「発言」になります
 「回答」回答される方が使います。
 
 |  |