![]() |
Is there an easier way to address ranges??
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('UniqueBSNLis t'!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('UniqueBSNLis t'!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('UniqueBS NList'!C2),1)" Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess _ , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom End Sub --- Message posted from http://www.ExcelForum.com/ |
Is there an easier way to address ranges??
It didnt' seem to clear.
The code below assumes you want to copy a table in A4:Bnn from three sheets into a new sheet. In each of th ethree sheets, the length of the table is not know. The code adds a new worksheet. It then selects the range A4:Bnn fron the first named sheets & copies it to the new worksheet. Then, for te two other sheets, it copies A4:Bnn to the next available row in the new worksheet. Finally, the copied cells are sorted. Hopefully, you'll see the purpose and will be able to adapt it. Note that it is not necessary to select a range in order to use it. Option Explicit Sub FindUniqueBSN() ' ' FindUniqueBSN Macro Dim WSNew As Worksheet Set WSNew = Worksheets.Add WSNew.Name = "UniqueBSNList" With Worksheets("All Open Tickets") .Range(.Range("A4"), _ .Range("B4").End(xlDown)).Copy WSNew.Range("A1").PasteSpecial _ xlPasteValues End With With Worksheets("Tickets raised this month") .Range(.Range("A4"), _ .Range("B4").End(xlDown)).Copy WSNew.Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues End With With Worksheets("Tickets closed this month") .Range(.Range("A4"), .Range("B4").End(xlDown)).Copy WSNew.Range("A1").End(xlDown).Offset(1, 0).PasteSpecial _ xlPasteValues End With Application.CutCopyMode = False With WSNew .Range(.Range("A1"), _ .Range("B1").End(xlDown)).Sort _ Key1:=Range("B1"), _ Order1:=xlAscending, _ Header:=xlGuess, _ OrderCustom:=1, _ MatchCase:=False, _ Orientation:=xlTopToBottom End With End Sub Patrick Molloy Microsoft Excel MVP -----Original Message----- 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('UniqueBSNLi st'!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('UniqueBSNLi st'!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('UniqueB SNList'! C2),1)" Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess _ , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom End Sub --- Message posted from http://www.ExcelForum.com/ . |
Is there an easier way to address ranges??
See one more reply to your other post.
dororke wrote: 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('UniqueBSNLis t'!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('UniqueBSNLis t'!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('UniqueBS NList'!C2),1)" Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess _ , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom End Sub --- Message posted from http://www.ExcelForum.com/ -- Dave Peterson |
All times are GMT +1. The time now is 10:39 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com