G'day
I use this to extract certain data from one sheet into multiple.
You will have to modify it to suit your data criteria.
Sub Split_Data()
Dim SourceSheet As Worksheet
Dim DestinationSheet As Worksheet
Dim rng As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Start of NSW
Sheets("NSW").Select
Set SourceSheet = Sheets("Data")
Set rng = SourceSheet.Range("A8:O" & Rows.Count)
Set DestinationSheet = Sheets("NSW")
SourceSheet.AutoFilterMode = False
rng.AutoFilter Field:=1, Criteria1:="=SYD"
SourceSheet.AutoFilter.Range.Copy
With DestinationSheet.Range("A5")
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Select
End With
Range("A4:O50").Select
Selection.Sort Key1:=Range("A4:A50"), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
'End of NSW
'Start of QLD
Sheets("Qld").Select
Set SourceSheet = Sheets("Data")
Set rng = SourceSheet.Range("A8:O" & Rows.Count)
Set DestinationSheet = Sheets("Qld")
SourceSheet.AutoFilterMode = False
rng.AutoFilter Field:=1, Criteria1:="=BNE"
SourceSheet.AutoFilter.Range.Copy
With DestinationSheet.Range("A5")
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Select
End With
Range("A4:O50").Select
Selection.Sort Key1:=Range("A4:A50"), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
'End of QLD
'Start of SA
Sheets("SA").Select
Set SourceSheet = Sheets("Data")
Set rng = SourceSheet.Range("A8:O" & Rows.Count)
Set DestinationSheet = Sheets("SA")
SourceSheet.AutoFilterMode = False
rng.AutoFilter Field:=1, Criteria1:="=ADL"
SourceSheet.AutoFilter.Range.Copy
With DestinationSheet.Range("A5")
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Select
End With
Range("A4:O50").Select
Selection.Sort Key1:=Range("A4:A50"), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
'End of SA
'Start of Vic
Sheets("Vic").Select
Set SourceSheet = Sheets("Data")
Set rng = SourceSheet.Range("A8:O" & Rows.Count)
Set DestinationSheet = Sheets("Vic")
SourceSheet.AutoFilterMode = False
rng.AutoFilter Field:=1, Criteria1:="=MEL"
SourceSheet.AutoFilter.Range.Copy
With DestinationSheet.Range("A5")
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Select
End With
Range("A4:O50").Select
Selection.Sort Key1:=Range("A4:A50"), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
'End of Vic
'Start of WA
Sheets("WA").Select
Set SourceSheet = Sheets("Data")
Set rng = SourceSheet.Range("A8:O" & Rows.Count)
Set DestinationSheet = Sheets("WA")
SourceSheet.AutoFilterMode = False
rng.AutoFilter Field:=1, Criteria1:="=PER"
SourceSheet.AutoFilter.Range.Copy
With DestinationSheet.Range("A5")
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Select
End With
SourceSheet.AutoFilterMode = False
Range("A4:O50").Select
Selection.Sort Key1:=Range("A4:A50"), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
'End of WA
With Application
CalcMode = .Calculation
.Calculation = xlAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
HTH
Mark.