VBA to create multiple workbooks based on sheet cell

[kweaver]

I have tried various approaches I've seen on the internet to no avail.
I have a workbook with a worksheet named "Reformatted". In P1 I have the text: SUPER
In the rest of column P I have 2-character codes.

I'd like to loop through this sheet and create a number of additional workbooks, each with 1 sheet.
That 1 sheet would be the filtered columns A to O based on each unique value in column P (starting in row 2).

So, if I have 10 rows with P2:P_whatever that contain "DT" for example, I want those 10 rows, columns A to O in a new workbook and it can be named "DT".
Then, looping, I want to re-filter to find the next set of rows with another "SUPER" in that P column and create another workbook.

I do have a string that contains the PATH where I want all the workbooks save.

Am I clear enough or need to provide more info?

Thanks in advance.

 

[kweaver]

I wonder if it's because I had the original workbook open (with the macro) by Excel 365 and the other file open via Excel 2010.
I'll try it using both versions.

Nope...that didn't matter. Didn't close it and just ignored it totally.

 

[DanteAmor]

I wonder if it's because I had the original workbook open (with the macro) by Excel 365 and the other file open via Excel 2010.
I'll try it using both versions.

Nope...that didn't matter. Didn't close it and just ignored it totally.

It is rare, if it is open in the same excel, that is, you open the file that contains the macro, with that same excel you open one of the books to be used, then the macro closes it.

Try this:

Sub Test()
  Dim sh As Worksheet, c As Range, ky As Variant, wb As Workbook, wPath As String, lr As Long
  '
  Application.SheetsInNewWorkbook = 1
  Application.ScreenUpdating = False
  '
  On Error Resume Next
  Set sh = Sheets("Reformatted")
  wPath = "C:\trabajo\books\"
  '
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  lr = sh.Range("P" & Rows.Count).End(xlUp).Row
  With CreateObject("scripting.dictionary")
    For Each c In sh.Range("P2:P" & lr)
      .Item(c.Value) = Empty
    Next
    For Each ky In .Keys
      sh.Range("A1").AutoFilter 16, ky
      Set wb = Workbooks.Add
      sh.AutoFilter.Range.Range("A2:O" & lr).Copy Range("A1")  'Change 2 to 1 if you also want to copy the header.
      Workbooks(ky & ".xlsx").Close False
      wb.SaveAs wPath & ky
      werr = Err.Number
      If Err.Number = 1004 Then
        MsgBox "The book " & ky & ".xlsx is open" & vbCr & "This operation is canceled."
      End If
      wb.Close False
    Next
  End With
  sh.ShowAllData
End Sub

 

[kweaver]

That was a good idea and try but still no luck.

I got the warning if the workbook being saved was already existing, and they got another "operation is cancelled" message anyway.
It still didn't close the one that was open.

I realize this is way beyond my pay grade! LOL. I'm happy to live with the first macro that works just fine -- as long as I realize that any workbook being altered cannot be open at the same time. Not a problem.

Thanks for your continual comments.

Kevin

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.