データベースであるファイルが1つあり、さまざまなクラスのすべての学生のデータが含まれています。データベースから新しいファイルにデータをコピーしてクラスごとのファイルを作成したい...以下のコードを使用していますが、これらは完全に機能していますが、列Gまでのデータのみをコピーし、現在はデータが列Zに拡張されており、機能していません実行時エラーを教えてください。
「Note Column B title Class」つまり新規保存ファイルのタイトル
Sub proSaveDateClasswise()
Range("I1").Value = "Class"
Columns("B:B").AdvancedFilter Action:=xlFilterCopy, copyToRange:=Columns( _
"I:I"), unique:=True
Range("J1").Value = "Class"
Dim cell As Range
Dim curPath As String
curPath = ActiveWorkbook.Path & "\Extracted Files\\"
If Len(Dir(curPath, vbDirectory)) = 0 Then
MkDir (curPath)
End If
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each cell In Range("I:I")
If cell.Value <> "Branch" And cell.Value <> "" Then
Range("J2").Value = cell.Value
Range("A:G").AdvancedFilter Action:=xlFilterCopy, _
criteriarange:=Range("J1:J2"), copyToRange:=Range("L:R"), unique:=False
Range(Range("L1:R1"), Range("L1:R1").End(xlDown)).Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:=curPath & cell.Value & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Range(Range("L1:R1"), Range("L1:R1").End(xlDown)).ClearContents
End If
Next cell
Columns("I:R").Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub