To create new worksheets from existing table ...

Hi All,

I am a very beginner in VBA in Excel and I would like to get a help from you guys. For some of you below problem may be easy but for me it is very difficult. I will shorthly explain:

In attached file is worksheet called "Data". This a database for next task: which is creation of new worksheets. I need to create macro which will:
1. Create new worksheet according to column J (after this there should be three new worksheets: Denmark, Australia and Belgium). The name of new worksheet should be the same as name in column J.
2. In each new worksheet data in the table should be sorted by column I (currency, ascending).
3. It is also important that the first four rows remains the same in each new worksheet.

I hope that I made myself clear enough and I really hope to get your help.
Please ask me if there is somehting unclear.

Thank you in advance.
Sylwester

It is also important that the first four rows remains the same in each new worksheet.

Not sure what this means. Do you mean the 3 Denmark rows should appear on every sheet?

Originally Posted by StephenR

Not sure what this means. Do you mean the 3 Denmark rows should appear on every sheet?

Hi Stephen,

No. I meant that in each new worksheet rows from 1-4 should be the same as rows from 1-4 in "Data" sheet.
In these rows I have another data but I have deleted them to make it easier to see, I only left "STATEMENT OF ACCOUNT" there.

So to sum up:
1. "Denmark" worksheet. Rows 1-4 the same as in "Data". Rows from 5 - etc: sorted data from macro.

Please let me know if it is more clear now.
Sylwester

Sylwester- this should do everything but insert the three rows. Having extra rows at the top of the first sheet will mess up the AutoFilter so would be better kept elsewhere. Code could be amended, but maybe rethink your layout.

Sub Macro2()
 
Dim rng As Range, rng2 As Range, ws As Worksheet
 
Application.DisplayAlerts = False

With Sheets("Data")
    Sheets.Add().Name = "Temp"
    .Range("J5", .Range("J5").End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Temp").Range("A1"), Unique:=True
    Set rng = Sheets("Temp").Range("A2", Sheets("Temp").Range("A2").End(xlDown))
    For Each rng2 In rng
        .Range("A5").AutoFilter field:=10, Criteria1:=rng2
        Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        .AutoFilter.Range.Copy ws.Range("A1")
        ws.Name = rng2
    Next rng2
    Sheets("Temp").Delete
    .AutoFilterMode = False
End With
 
Application.DisplayAlerts = True
    
End Sub