1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
| Sub addworkbook()
Dim onewbook As Workbook
Dim obasebook As Workbook
Set obasebook = ActiveWorkbook
Set onewbook = Workbooks.Add
With onewbook
.SaveAs Filename:="part1"
End With
Dim shArray() As Variant 'Declare the sheet Name array and a
Dim i As Integer 'counter variable
shArray = Array("Regularisation actions", "Mitigation actions", "General info", "Statistics", "Instruction") 'Populate the array
For i = LBound(shArray) To UBound(shArray) 'Loop through the elements
Sheets.Add().Name = shArray(i)
Next i
'copy instruction of obasebook to newbook
obasebook.Sheets("Instruction").Cells.Copy Destination:=onewbook.Sheets("Instruction").Range("a1")
obasebook.Sheets("general Info").Select
Columns("A7:Q6500").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
obasebook.Sheets("DO NOT TOUCH").Range("b5:b8"), Unique:=False
obasebook.Sheets("General Info").Cells.Select
Selection.Copy Destination:=Workbooks("part1").Sheets("General Info").Range("a7")
obasebook.Sheets("general Info").Activate
end sub |
