Code that auto filters but also need to add copy workbook

[danboi1010]

Hi, have been on this forum before, only a few times but unfortunately was made redundant and lost my login details........never use your work details for logging in!!!

I have a query that i hope someone can help with.

I've adapted a vba code from the net to copy and paste from my data template (the template has an instructions sheet and a data sheet)to a new workbook based on an auto filter. It splits the data on column 2 and then pastes and saves to a new workbook, it loops through the criteria and works well. The issue that I have is that I would also like to copy and paste the template instructions page into each of the new workbooks. Please see the below code:

Sub ExtractToNewWorkbook()


Dim ws1     As Worksheet


Dim wsNew  As Workbook


Dim rData  As Range


Dim rfl    As Range


Dim status  As String


Dim sfilename As String






Set ws1 = ThisWorkbook.Sheets("Data Validation")




'Apply advance filter in your sheet


With ws1


Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 5).End(xlUp))


.Columns(.Columns.Count).Clear


.Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True






For Each rfl In .Range(.Cells(1, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))


status = rfl.Text




Set wsNew = Workbooks.Add
Sheets("Sheet2").Activate




sfilename = status & ".xlsx"


'Set the Location


ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sfilename


Application.DisplayAlerts = False


ws1.Activate


rData.AutoFilter Field:=2, Criteria1:=status


rData.Copy


Windows(status).Activate


ActiveSheet.Paste
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 8
End With


Cells.Select
With Selection
.VerticalAlignment = xlBottom
.HorizontalAlignment = xlLeft
Selection.ColumnWidth = 80
Cells.EntireColumn.AutoFit
End With




Rows.Select
Selection.RowHeight = 41.25




ActiveWorkbook.Close SaveChanges:=True


Next rfl


Application.DisplayAlerts = True


End With


ws1.Columns(Columns.Count).ClearContents


rData.AutoFilter


End Sub

Any help would be appreciated.

Thanks,
Dan.

 

[danboi1010]

Re: Help with VBA coding - have a code that auto filters but also need to add copy workbook

Yes, it’ll contain different values.

I’ll just spilt the two separate files and just put them back together.

Thanks for the code though.

 

[Fluff]

Re: Help with VBA coding - have a code that auto filters but also need to add copy workbook

If you're happy doing that, that's fine.
The other option, is start a new thread, post the code you're using from here & explain how you'd like it modified.