What does that mean?Code breaks down at that line according to debugger. It seems that code wants to cycle through the first file tested over and over again, producing further versions of the same worksheets. It needs to know that it's done its job on the file and should move on.
The main issue seems to be that, rather than just splitting all the worksheets into new files, it also wants to create a new file containing all the worksheets together. If that could be prevented, it is likely the problem may go away.
Dim n as a Variant. You have been looping thru the code n number of times, but you had used a zero instead of n for the file to open.
couldn't find that issue.
You do realize that this code will also convert the workbook that it is in?
This version works on my machine.
Option Explicit Function ListFiles() ' Subfolder depth: -1 = All subfolders, 0 = No subfolders, 1 or any positive value = maximum depth Dim dot As Long Dim ext As String Dim n As Variant Dim NewName As String Dim oFile As Object Dim oFiles As Object Dim oFolder As Variant Dim oShell As Object Dim Wkb As Workbook Dim NewBook As Workbook '<<<<<<<<<<<<<<<<<<<<< Dim WkbName As String Dim Wks As Worksheet Dim FileFilter As String Const FolderPath As Variant = "C:\CSVs\A\" If oShell Is Nothing Then Set oShell = CreateObject("Shell.Application") If FileFilter = "" Then FileFilter = "*.*" Set oFolder = oShell.Namespace(FolderPath) If oFolder Is Nothing Then MsgBox "The Folder '" & FolderPath & "' Does Not Exist.", vbCritical 'SearchSubFolders = False Exit Function End If Set oFiles = oFolder.Items ' Return all the files matching the filter. oFiles.Filter 64, FileFilter 'Split each workbook's worksheets into new workbooks. For n = 0 To oFiles.Count - 1 WkbName = oFolder.Self.Path & "\" & oFiles.Item(n).Name Set Wkb = Workbooks.Open(WkbName, False, True) X = Wkb.Name dot = InStrRev(Wkb.Name, ".") ext = Right(Wkb.Name, Len(Wkb.Name) - dot + 1) WkbName = Wkb.Path & "\" & Left(Wkb.Name, dot - 1) For Each Wks In Wkb.Worksheets NewName = WkbName & "_" & Wks.Name '<-<-<-<- Wks.Copy 'Immediately set a variable the newly created book Set NewBook = Workbooks(Workbooks.Count) '<<<<<<<<<<<<<<<<< NewBook.SaveAs NewName & "_" & Left(CStr(CDbl(Now)), 10) & ext '<<<<<<<<<<<<<< NewBook.Close '<<<<<<<<<<<<< Next Wks Wkb.Close SaveChanges:=False Next n ' Return subfolders in this folder. oFiles.Filter 32, "*" If oFiles.Count = 0 Then Exit Function 'If SubfolderDepth <> 0 Then 'For Each oFolder In oFiles 'Call ListFiles(oFolder, SubfolderDepth - 1) 'Next oFolder 'End If End Function




Reply With Quote