Please help VBA Coding for Repeat Task for Step 2 to Step 6

[newbiee]

Hi

I am new at this level of VBA can anyone help me. How can i write a VBA code for Step 2 to Step 6

I have a wokbook with a sheet called "Datasheet" and I would like to split the data by the "Origin" and insert a Pivot Table from the Datasheet.


1 Sorts the column D4 (Field: Origin) from Datasheet
2 Filter "USA" from column D4 and copy into new workbooks
3 rename the worksheet as "USA"
4 Insert a Pivot table from "USA" worksheet
5 Add "Origin","Type", "Make" & "Engine Size" into row field and add "MSRP" into sum field
6 Save as the workbook as "USA Car Sales as at September 2019"
7 repeat step 2 to step 6 for "ASIA" & "EUROPE"


I have shown an sample for a "USA" sheet and a pivot table. How can write a VBA to automate it for my monthly report.



Sub Macro1()
'
' Macro1 Macro
'
Sheets("Datasheet").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Worksheets("Datasheet").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Datasheet").AutoFilter.Sort.SortFields.Add Key:= _
Range("D4:D432"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("Datasheet").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$A$4:$O$432").AutoFilter Field:=4, Criteria1:="Asia"
Range("A9").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.GoTo ActiveSheet.Range("A1"), True
ActiveSheet.Name = "Asia"
Windows("CARS.xlsx").Activate
ActiveSheet.Range("$A$4:$O$432").AutoFilter Field:=4
Application.GoTo ActiveSheet.Range("A1"), True

End Sub

[p45cal]

Sub blah()
Dim afrng As Range
With Sheets("Datasheet")
'remove any existing autofilter:
On Error Resume Next
Set afrng = .AutoFilter.Range
On Error GoTo 0
If Not afrng Is Nothing Then afrng.AutoFilter
'find the data:
Set rngMyData = .Range("A1").End(xlDown).CurrentRegion
Continents = Array("Asia", "Europe", "USA")
With rngMyData
'loop through the 3 continents:
For Each Continent In Continents
.AutoFilter Field:=4, Criteria1:=Continent
Set NewSht = Sheets.Add(After:=Sheets(Sheets.Count))
NewSht.Name = Continent
.SpecialCells(xlCellTypeVisible).Copy NewSht.Range("A1")
'make it a new workbook:
NewSht.Move
Set NewWkBk = ActiveWorkbook
'add a pivot
Stop 'stop the macro here, abort it, then record your making a a pivot table in the new workbook and post the code.
'save as
NewWkBk.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & Continent & ".xlsx", FileFormat:=xlOpenXMLWorkbook
NewWkBk.Close False
Next Continent
End With
End With
End Sub
See comments in the above code.