D
dororke
Hi,
I've created the bit of code below to copy a row of data from 3
worksheets to one worksheet so that the rows are appended to each other
and then finally sorted.
The code works fine but seems to be rather cumbersome. Is there an
easier way of addressing ranges rather than having to create/define
them first? Any advice of my use of the other fuctions would also be
greatly appreciated.
Thanks in advance,
Dan
Sub FindUniqueBSN()
'
' FindUniqueBSN Macro
Dim WS1Name As String
Dim WS2Name As String
Dim WS3Name As String
Sheets.Add.Name = "UniqueBSNList"
WS1Name = "All Open Tickets"
WS2Name = "Tickets raised this month"
WS3Name = "Tickets closed this month"
'Set up 3 ranges for each worksheet
ActiveWorkbook.Names.Add Name:="WS1BSN", RefersToR1C1:= _
"=OFFSET('" & WS1Name & "'!R4C2,0,0,COUNTA('" & WS1Name &
"'!C1)-2,1)"
ActiveWorkbook.Names.Add Name:="WS2BSN", RefersToR1C1:= _
"=OFFSET('" & WS2Name & "'!R4C2,0,0,COUNTA('" & WS2Name &
"'!C1)-2,1)"
ActiveWorkbook.Names.Add Name:="WS3BSN", RefersToR1C1:= _
"=OFFSET('" & WS3Name & "'!R4C2,0,0,COUNTA('" & WS3Name &
"'!C1)-2,1)"
'Copy 1st range to new worksheet
Sheets(WS1Name).Select
Range("WS1BSN").Select
Selection.Copy Sheets("UniqueBSNList").Range("B2")
'Copy 2nd range to new worksheet but at end of 1st range
Sheets(WS2Name).Select
Range("WS2BSN").Select
ActiveWorkbook.Names.Add Name:="BSNLength", RefersToR1C1:= _
"=OFFSET('UniqueBSNList'!R1C2,COUNTA('UniqueBSNList'!C2)+1,0)"
Selection.Copy Sheets("UniqueBSNList").Range("BSNLength")
'Copy 3rd range to new worksheet but at end of both previous ranges
Sheets(WS3Name).Select
Range("WS3BSN").Select
ActiveWorkbook.Names.Add Name:="BSNLength", RefersToR1C1:= _
"=OFFSET('UniqueBSNList'!R1C2,COUNTA('UniqueBSNList'!C2)+1,0)"
Selection.Copy Sheets("UniqueBSNList").Range("BSNLength")
'Select entire range then sort it
ActiveWorkbook.Names.Add Name:="BSNLength", RefersToR1C1:= _
"=OFFSET('UniqueBSNList'!R2C2,0,0,COUNTA('UniqueBSNList'!C2),1)"
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess
_
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
I've created the bit of code below to copy a row of data from 3
worksheets to one worksheet so that the rows are appended to each other
and then finally sorted.
The code works fine but seems to be rather cumbersome. Is there an
easier way of addressing ranges rather than having to create/define
them first? Any advice of my use of the other fuctions would also be
greatly appreciated.
Thanks in advance,
Dan
Sub FindUniqueBSN()
'
' FindUniqueBSN Macro
Dim WS1Name As String
Dim WS2Name As String
Dim WS3Name As String
Sheets.Add.Name = "UniqueBSNList"
WS1Name = "All Open Tickets"
WS2Name = "Tickets raised this month"
WS3Name = "Tickets closed this month"
'Set up 3 ranges for each worksheet
ActiveWorkbook.Names.Add Name:="WS1BSN", RefersToR1C1:= _
"=OFFSET('" & WS1Name & "'!R4C2,0,0,COUNTA('" & WS1Name &
"'!C1)-2,1)"
ActiveWorkbook.Names.Add Name:="WS2BSN", RefersToR1C1:= _
"=OFFSET('" & WS2Name & "'!R4C2,0,0,COUNTA('" & WS2Name &
"'!C1)-2,1)"
ActiveWorkbook.Names.Add Name:="WS3BSN", RefersToR1C1:= _
"=OFFSET('" & WS3Name & "'!R4C2,0,0,COUNTA('" & WS3Name &
"'!C1)-2,1)"
'Copy 1st range to new worksheet
Sheets(WS1Name).Select
Range("WS1BSN").Select
Selection.Copy Sheets("UniqueBSNList").Range("B2")
'Copy 2nd range to new worksheet but at end of 1st range
Sheets(WS2Name).Select
Range("WS2BSN").Select
ActiveWorkbook.Names.Add Name:="BSNLength", RefersToR1C1:= _
"=OFFSET('UniqueBSNList'!R1C2,COUNTA('UniqueBSNList'!C2)+1,0)"
Selection.Copy Sheets("UniqueBSNList").Range("BSNLength")
'Copy 3rd range to new worksheet but at end of both previous ranges
Sheets(WS3Name).Select
Range("WS3BSN").Select
ActiveWorkbook.Names.Add Name:="BSNLength", RefersToR1C1:= _
"=OFFSET('UniqueBSNList'!R1C2,COUNTA('UniqueBSNList'!C2)+1,0)"
Selection.Copy Sheets("UniqueBSNList").Range("BSNLength")
'Select entire range then sort it
ActiveWorkbook.Names.Add Name:="BSNLength", RefersToR1C1:= _
"=OFFSET('UniqueBSNList'!R2C2,0,0,COUNTA('UniqueBSNList'!C2),1)"
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess
_
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub