VBA query Help -Scenario

New Contributor

I have a data that is 10000 records which is the Orders Data

Steps I perform now

1. Go to Orders Data :- Set some standard filters on the sheet. Copy the data along (with HEADERS) and paste in say Sheet1.


2. Go to Orders Data :- Set some standard filters again on the sheet. Copy the data (without the Headers) and paste it on Sheet2.


3. Add another Sheet3

4. copy the data from Sheet1 with Headers and Paste. 

4. Copy the data from Sheet2 and append it below Sheet1 last row where it ended.


How can I automate this using VBA


I have managed it do a bit of it..Don't know where Im going wrong


Sub dave()

On Error Resume Next 'proceed in case of error (if sheets doesn't excist)
Application.DisplayAlerts = False 'give no alert
Sheets("sheet1").Delete 'delete those sheets
Application.DisplayAlerts = True
On Error GoTo 0

With Sheets("Orders") '<---------give here the name of the sheet, i think it's Orders
With .Range("$A$1:$U$9995")
.AutoFilter Field:=8, Criteria1:="Home Office" '1st filter
.SpecialCells(xlVisible).Copy 'the visible cells only

Sheets.Add After:=ActiveSheet 'copy a first time to sheet1
With ActiveSheet
.Name = "SHEET1"
End With

Sheets.Add After:=ActiveSheet 'copy a 2nd time to sheet3
With ActiveSheet
.Name = "SHEET3"
End With

.AutoFilter Field:=13, Criteria1:="East" '2nd filter

Sheets.Add After:=ActiveSheet 'copy a 1st time to sheet2
With ActiveSheet
.Name = "SHEET2"
End With

.Offset(1).SpecialCells(xlVisible).Copy 'copy a 2nd time and append in sheet3
With Sheets("sheet3") 'to a 3rd sheet
With .Range("A" & Rows.Count).End(xlUp).Offset(1) 'next free A-cell
End With
End With

End With
End With

End Sub



0 Replies