Hello,
I've been searching online and am trying to find a solution to what I think should be easy to do. (Not so easy to me, as I'm not so proficient with VBA)
I have a master sheet with information for multiple vendors and I would like to create a macro that would automatically would extract all rows of that particular vendor to a new workbook.
I would want all formatting and column headers to read the same on all workbooks. specifically from A1-A7 through BA1-BA7, should be the header info on all sheets.
Ideally, I would like to select each time with a dropdown menu if possible which vendor i'd like extract.
If i NEED to extract all vendors at the same time, then I can deal with that.
I found something similar in a different post and tried that code, but was having errors with it.
Please help!
Attached is what i have so far....anerror occurs at the rdata.copy destination line
Sub ExtractToNewWorkBook()
'
' Breakout_Schedule Macro
' Create New Sheets from Breakout Schedule
'
Dim ws As Worksheet
Dim rData As Range
Dim rCl As Range
Dim sNm As String
Set ws = Sheet1
' make sure this is correct
'extract a list of unique names
'first clear existing list
With ws 'change the ranges to suit
Set rData = .Range(.Cells(7, 1), .Cells(.Rows.Count, 14).End(xlUp))
.Columns(.Columns.Count).Clear
.Range(.Cells(8, 1), .Cells(.Rows.Count, 1).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(7, .Columns.Count), Unique:=True
For Each rCl In .Range(.Cells(7, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))
sNm = rCl.Text
'AutoFilter & copy to relevant sheet
rData.AutoFilter Field:=1, Criteria1:=sNm
Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & Application.PathSeparator & sNm & ".xls"
rData.Copy Destination:=Workbooks(sNm).Sheets(1).Cells(1, 1)
Workbooks(sNm).Close True
Next rCl
End With
ws.Columns(Columns.Count).ClearContents 'remove temporary list
rData.AutoFilter 'switch off AutoFilter
End Sub
'
Attachment 206529
thanks
Sammy
Bookmarks