Copy rows and column headings to new workbook based on cell value

[Daph1990]

Hello everyone,

Hoping someone can help. I've got some data in a table and one of the columns (L) has a value of "Yes" or "No". I would like a code to be able to copy across columns B, C, D, E and K to a new workbook (along with the column headings) if Column L has a value of "No".

After this I would then like to be able to split the newly copied data into separate tabs based on Column C. So for example if column C says "Property" I'd like all those that say "Property" on its own tab and I'd like this to continue across all the different categories in column C (6 different categories included).

This far I've only managed to add a new workbook but I get a little stuck after that. I've attached a dummy file showing what the data looks like. This is the code I have so far:

Dim wb As WorkbookDim FileName As String


Set wb = Workbooks.Add
Application.DisplayAlerts = False


fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")


'If user has specified file name, perform Save and display a message box
If fileSaveName <> False Then
ActiveWorkbook.SaveAs FileName:=fileSaveName, FileFormat:=52

MsgBox "Save as " & fileSaveName
End If


Application.DisplayAlerts = True




Thank you so much!

[mana]

you can use advancedfilter


Option Explicit


Sub test()
Dim ws As Worksheet
Dim r As Range
Dim c As Range
Dim wb As Workbook

Set ws = Sheets("All Suppliers")
Set r = ws.Range("a18", Range("a" & Rows.Count).End(xlUp)).Resize(, 12)
Set c = ws.Range("o1")

r.Columns("c").AdvancedFilter xlFilterCopy, , c, True
c.Offset(, 1).Value = r.Range("L1").Value
c.Offset(1, 1).Value = "No"

Set wb = Workbooks.Add(xlWBATWorksheet)

Do While c.Offset(1).Value <> ""
With wb.Worksheets.Add
.Name = c.Offset(1).Value
r.Range("b1:e1,k1").Copy .Range("a1")
r.AdvancedFilter xlFilterCopy, c.Resize(2, 2), .Range("a1:e1")
End With
c.Offset(1).Delete xlShiftUp
Loop

c.Resize(2, 2).ClearContents
Application.DisplayAlerts = False
wb.Sheets(wb.Sheets.Count).Delete
Application.DisplayAlerts = True

End Sub



マナ

[Daph1990]

Omg @mana thank you so much, it worked an absolute treat. You've saved me so much time, and with such a short and elegant piece of code. Thank you!!!

[Daph1990]

@mana everything works perfectly but the way I wanted this code to work is that I wanted there to be a button on another sheet that runs this code. But this only seems to work when the sheet 'All Suppliers' is active. Is there a way to amend this so any sheet can be active when the button is pressed?

[mana]

??

> Set ws = Sheets("All Suppliers")

Set ws = Activesheet

[Daph1990]

Maybe I'm not explaining properly. This code works great and I do want it to be ws=Sheets("All Suppliers") because that's where all the data is, but when I place a button on another sheet and run this code I get the error on line
Set r = ws.Range("a18", Range("a" & Rows.Count).End(xlUp)).Resize(, 12) and was wondering why that would happen because I didn't think it would matter which sheet I run the code from

[mana]

Sorry

>Set r = ws.Range("a18", Range("a" & Rows.Count).End(xlUp)).Resize(, 12)

Set r = ws.Range("a18", ws.Range("a" & Rows.Count).End(xlUp)).Resize(, 12)

[Daph1990]

Perfect, such a simple fix. Thank you again!!!