0

Sorry if not enough info - first post! I have the following set of Macros that when run follows a path to each task. This works if I manually run it from the workbook I require, however I am looking for the ability to run the same Macro for all files in a folder. Eg, File 1,2,3,4,5 will each run the Macro below creating the new files for each. What is the best way to achieve this? Tried using this code, but this seems to only create files for the existing open workbook that contains no data:

Sub DirectoryFileLoop2()
Dim fileName As Variant
fileName = Dir("C:\New Name Test\ConvertxlsxTest\Test3\")
Application.ScreenUpdating = False
While fileName <> ""
Call CreateUniqueContainers
fileName = Dir
Wend
End Sub

Macro To Run Working when run from single file

Sub CreateUniqueContainers()
Dim xRCount As Long
Dim xSht As Worksheet
Dim xNSht As Worksheet
Dim I As Long
Dim xTRrow As Integer
Dim xCol As New Collection
Dim xTitle As String
Dim xSUpdate As Boolean
Set xSht = ActiveSheet
On Error Resume Next
xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row
xTitle = "A1:BK1"
xTRrow = xSht.Range(xTitle).Cells(1).Row
For I = 2 To xRCount
    Call xCol.Add(xSht.Cells(I, 7).Text, xSht.Cells(I, 7).Text)
Next
xSUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
For I = 1 To xCol.Count
    Call xSht.Range(xTitle).AutoFilter(7, CStr(xCol.Item(I)))
    Set xNSht = Nothing
    Set xNSht = Worksheets(CStr(xCol.Item(I)))
    If xNSht Is Nothing Then
        Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
        xNSht.Name = CStr(xCol.Item(I))
    Else
        xNSht.Move , Sheets(Sheets.Count)
    End If
    xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
    xNSht.Columns.AutoFit
Next
xSht.AutoFilterMode = False
xSht.Activate
Application.ScreenUpdating = xSUpdate

Call CreateNewWorkbookForEachContainerSheet
End Sub
Sub CreateNewWorkbookForEachContainerSheet()
Dim ws As Worksheet
Dim Path As String
Path = "C:\New Name Test\ConvertxlsxTest\TestFull"
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
ws.Copy
ActiveSheet.Name = "Container"
Sheets("Container").Copy After:=Worksheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = "Orders"
Sheets("Container").Copy After:=Worksheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = "Items"
ActiveWorkbook.SaveAs Path & "\" & ws.Name
ActiveWorkbook.Close SaveChanges:=True
Next ws
Application.ScreenUpdating = True

Call Delete_Sheet1
End SubSub Delete_Sheet1()
Kill "C:\New Name Test\Sheet1.xlsx"
End Sub
BigBen
  • 46,229
  • 7
  • 24
  • 40
Scott Manning
  • 1
  • 2
  • Likely you need to add a `Workbook` parameter to `CreateUniqueContainers`, and `CreateNewWorkbookForEachContainerSheet`. Then replace all `ThisWorkbook` calls with a reference to that `Workbook` parameter. Also avoid using `ActiveSheet`. – BigBen Aug 26 '22 at 14:49
  • What do you suggest I chane this to then to get the desired affect as I have been trying code for 2 hours including the 'linked question' and these do not help? – Scott Manning Aug 26 '22 at 15:09
  • First step is to add a `Workbooks.Open` call in `DirectoryFileLoop2`. See if you can get that working first. Note that the linked question has this step. – BigBen Aug 26 '22 at 15:10
  • Sorry, new to this and can't understand what from the linked question I need to include to get this macro to run on each file independently? What am I missing? – Scott Manning Sep 02 '22 at 12:42
  • `While fileName <> ""`, `Dim wb As Workbook`, `Set wb = Workbooks.Open("C:\New Name Test\ConvertxlsxTest\Test3\" & fileName)`, for starters. – BigBen Sep 02 '22 at 12:46
  • Then you need to modify `Sub CreateUniqueContainers()` to accept a workbook parameter: `Sub CreateUniqueContainers(ByVal wb As Workbook)` – BigBen Sep 02 '22 at 12:46
  • Thanks @BigBen - so I have added these 3 to the CreateUniqueContainers - `While fileName <> "", Dim wb As Workbook, Set wb = Workbooks.Open("C:\New Name Test\ConvertxlsxTest\Test3\" & fileName)` - however I am getting acompile error when trying to run of 'While without Wend' Starting to think I am in deep over my own head now – Scott Manning Sep 05 '22 at 08:18
  • So you need a `Wend` to close the `While` loop. – BigBen Sep 05 '22 at 12:06
  • @BigBen nope, can't get that to run correctly creating the files. Ill go back to the drawing board. – Scott Manning Sep 06 '22 at 10:48

0 Answers0