Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with Mr Doug Glancy Code - Snake Columns
Note: I had already posted it but no reply was received so I am reposting
under a different subject Hello All, I am using Office XP and the following macro was posted by Mr. Doug Glancy to my previous question about Snake Columns. The macro works perfect but every time I have to make a new Workbook I wish to change this to work for Sheets in the same workbook. At present it is working for only Sheet2 of a new Workbook only. I tried to change Sheet3 Name to Sheet2 but it works only once. How can I amend it to work in the same Sheet for other subsequent Sheets? The macro should stop and ask for the new Sheet name prior to copying the snake column. Sub test() Dim first_row As Long, last_row As Long first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) Sheet1.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) Sheet1.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) first_row = last_row + 2 Wend End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with Mr Doug Glancy Code - Snake Columns
Rashid,
This will work on the active sheet, and ask for the name of the destination sheet. Note that there is no error checking on the input of the sheet name. HTH, Bernie MS Excel MVP Sub Test2() Dim first_row As Long, last_row As Long Dim mySheet As Worksheet Dim myName As String myName = InputBox("Enter the sheet name") Set mySheet = Worksheets(myName) first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) ActiveSheet.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) ActiveSheet.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) first_row = last_row + 2 Wend End Sub "Rashid Khan" wrote in message ... Note: I had already posted it but no reply was received so I am reposting under a different subject Hello All, I am using Office XP and the following macro was posted by Mr. Doug Glancy to my previous question about Snake Columns. The macro works perfect but every time I have to make a new Workbook I wish to change this to work for Sheets in the same workbook. At present it is working for only Sheet2 of a new Workbook only. I tried to change Sheet3 Name to Sheet2 but it works only once. How can I amend it to work in the same Sheet for other subsequent Sheets? The macro should stop and ask for the new Sheet name prior to copying the snake column. Sub test() Dim first_row As Long, last_row As Long first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) Sheet1.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) Sheet1.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) first_row = last_row + 2 Wend End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with Mr Doug Glancy Code - Snake Columns
Hi Bernie,
It does not work for a single sheet also. It gives the following error: Run Time Error 9 Subscript out of range What is missing? Rashid "Bernie Deitrick" <deitbe @ consumer dot org wrote in message ... Rashid, This will work on the active sheet, and ask for the name of the destination sheet. Note that there is no error checking on the input of the sheet name. HTH, Bernie MS Excel MVP Sub Test2() Dim first_row As Long, last_row As Long Dim mySheet As Worksheet Dim myName As String myName = InputBox("Enter the sheet name") Set mySheet = Worksheets(myName) first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) ActiveSheet.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) ActiveSheet.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) first_row = last_row + 2 Wend End Sub "Rashid Khan" wrote in message ... Note: I had already posted it but no reply was received so I am reposting under a different subject Hello All, I am using Office XP and the following macro was posted by Mr. Doug Glancy to my previous question about Snake Columns. The macro works perfect but every time I have to make a new Workbook I wish to change this to work for Sheets in the same workbook. At present it is working for only Sheet2 of a new Workbook only. I tried to change Sheet3 Name to Sheet2 but it works only once. How can I amend it to work in the same Sheet for other subsequent Sheets? The macro should stop and ask for the new Sheet name prior to copying the snake column. Sub test() Dim first_row As Long, last_row As Long first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) Sheet1.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) Sheet1.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) first_row = last_row + 2 Wend End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with Mr Doug Glancy Code - Snake Columns
Rashid,
It will work for a single sheet. Are you typing in the sheet name correctly? I have never received that error message. HTH, Bernie MS Excel MVP "Rashid Khan" wrote in message ... Hi Bernie, It does not work for a single sheet also. It gives the following error: Run Time Error 9 Subscript out of range What is missing? Rashid "Bernie Deitrick" <deitbe @ consumer dot org wrote in message ... Rashid, This will work on the active sheet, and ask for the name of the destination sheet. Note that there is no error checking on the input of the sheet name. HTH, Bernie MS Excel MVP Sub Test2() Dim first_row As Long, last_row As Long Dim mySheet As Worksheet Dim myName As String myName = InputBox("Enter the sheet name") Set mySheet = Worksheets(myName) first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) ActiveSheet.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) ActiveSheet.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) first_row = last_row + 2 Wend End Sub "Rashid Khan" wrote in message ... Note: I had already posted it but no reply was received so I am reposting under a different subject Hello All, I am using Office XP and the following macro was posted by Mr. Doug Glancy to my previous question about Snake Columns. The macro works perfect but every time I have to make a new Workbook I wish to change this to work for Sheets in the same workbook. At present it is working for only Sheet2 of a new Workbook only. I tried to change Sheet3 Name to Sheet2 but it works only once. How can I amend it to work in the same Sheet for other subsequent Sheets? The macro should stop and ask for the new Sheet name prior to copying the snake column. Sub test() Dim first_row As Long, last_row As Long first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) Sheet1.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) Sheet1.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) first_row = last_row + 2 Wend End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with Mr Doug Glancy Code - Snake Columns
You should be identifying the line that you get the error on,
but Subscript out of range is the type of error that you would get for sheet not found. Make sure that you have not introduced spaces at the end of the sheet name. Do you have something that could be interpreted by Excel as a number. By the way if you have a suggestion you can supply a default sheetname to the InputBox. myName = TRIM(InputBox("Enter the sheet name", _ "supply sheetname", activesheet.name)) msgbox myname & "<-- verify" InputBox and MsgBox http://www.mvps.org/dmcritchie/excel/inputbox.htm --- HTH, David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001] My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm Search Page: http://www.mvps.org/dmcritchie/excel/search.htm "Rashid Khan" wrote in message ... Hi Bernie, It does not work for a single sheet also. It gives the following error: Run Time Error 9 Subscript out of range What is missing? Rashid "Bernie Deitrick" <deitbe @ consumer dot org wrote in message ... Rashid, This will work on the active sheet, and ask for the name of the destination sheet. Note that there is no error checking on the input of the sheet name. HTH, Bernie MS Excel MVP Sub Test2() Dim first_row As Long, last_row As Long Dim mySheet As Worksheet Dim myName As String myName = InputBox("Enter the sheet name") Set mySheet = Worksheets(myName) first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) ActiveSheet.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) ActiveSheet.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) first_row = last_row + 2 Wend End Sub "Rashid Khan" wrote in message ... Note: I had already posted it but no reply was received so I am reposting under a different subject Hello All, I am using Office XP and the following macro was posted by Mr. Doug Glancy to my previous question about Snake Columns. The macro works perfect but every time I have to make a new Workbook I wish to change this to work for Sheets in the same workbook. At present it is working for only Sheet2 of a new Workbook only. I tried to change Sheet3 Name to Sheet2 but it works only once. How can I amend it to work in the same Sheet for other subsequent Sheets? The macro should stop and ask for the new Sheet name prior to copying the snake column. Sub test() Dim first_row As Long, last_row As Long first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) Sheet1.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) Sheet1.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) first_row = last_row + 2 Wend End Sub |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with Mr Doug Glancy Code - Snake Columns
Hi Bernie,
Pardon me for my ignorance. Your code works if I supply the name viz. Sheet2 or Sheet3, but what I required was to have the macro to ask the name and then create the sheet with the new name supplied by me and copy the matter on that sheet. Hope I am clear now. Rashid Khan "Bernie Deitrick" <deitbe @ consumer dot org wrote in message ... Rashid, It will work for a single sheet. Are you typing in the sheet name correctly? I have never received that error message. HTH, Bernie MS Excel MVP "Rashid Khan" wrote in message ... Hi Bernie, It does not work for a single sheet also. It gives the following error: Run Time Error 9 Subscript out of range What is missing? Rashid "Bernie Deitrick" <deitbe @ consumer dot org wrote in message ... Rashid, This will work on the active sheet, and ask for the name of the destination sheet. Note that there is no error checking on the input of the sheet name. HTH, Bernie MS Excel MVP Sub Test2() Dim first_row As Long, last_row As Long Dim mySheet As Worksheet Dim myName As String myName = InputBox("Enter the sheet name") Set mySheet = Worksheets(myName) first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) ActiveSheet.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) ActiveSheet.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) first_row = last_row + 2 Wend End Sub "Rashid Khan" wrote in message ... Note: I had already posted it but no reply was received so I am reposting under a different subject Hello All, I am using Office XP and the following macro was posted by Mr. Doug Glancy to my previous question about Snake Columns. The macro works perfect but every time I have to make a new Workbook I wish to change this to work for Sheets in the same workbook. At present it is working for only Sheet2 of a new Workbook only. I tried to change Sheet3 Name to Sheet2 but it works only once. How can I amend it to work in the same Sheet for other subsequent Sheets? The macro should stop and ask for the new Sheet name prior to copying the snake column. Sub test() Dim first_row As Long, last_row As Long first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) Sheet1.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) Sheet1.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) first_row = last_row + 2 Wend End Sub |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with Mr Doug Glancy Code - Snake Columns
Hello David,
I have copied the complete macro here for you to have a look. It gives Run-time error '91' - Object variable or With block variable not set. It does not even copy the data on the Sheet2. My requirement is to have the selection to be copied to the Sheet name provided by me. The sheet should be created by the name which is supplied in the Input Box. Hope I am clear now. Any help would be appreciated Sub Test2() Dim first_row As Long, last_row As Long Dim mySheet As Worksheet Dim myName As String myName = Trim(InputBox("Enter the sheet name", _ "supply sheetname", ActiveSheet.Name)) MsgBox myName first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) ActiveSheet.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) ActiveSheet.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) first_row = last_row + 2 Wend End Sub "David McRitchie" wrote in message ... You should be identifying the line that you get the error on, but Subscript out of range is the type of error that you would get for sheet not found. Make sure that you have not introduced spaces at the end of the sheet name. Do you have something that could be interpreted by Excel as a number. By the way if you have a suggestion you can supply a default sheetname to the InputBox. myName = TRIM(InputBox("Enter the sheet name", _ "supply sheetname", activesheet.name)) msgbox myname & "<-- verify" InputBox and MsgBox http://www.mvps.org/dmcritchie/excel/inputbox.htm --- HTH, David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001] My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm Search Page: http://www.mvps.org/dmcritchie/excel/search.htm "Rashid Khan" wrote in message ... Hi Bernie, It does not work for a single sheet also. It gives the following error: Run Time Error 9 Subscript out of range What is missing? Rashid "Bernie Deitrick" <deitbe @ consumer dot org wrote in message ... Rashid, This will work on the active sheet, and ask for the name of the destination sheet. Note that there is no error checking on the input of the sheet name. HTH, Bernie MS Excel MVP Sub Test2() Dim first_row As Long, last_row As Long Dim mySheet As Worksheet Dim myName As String myName = InputBox("Enter the sheet name") Set mySheet = Worksheets(myName) first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) ActiveSheet.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) ActiveSheet.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) first_row = last_row + 2 Wend End Sub "Rashid Khan" wrote in message ... Note: I had already posted it but no reply was received so I am reposting under a different subject Hello All, I am using Office XP and the following macro was posted by Mr. Doug Glancy to my previous question about Snake Columns. The macro works perfect but every time I have to make a new Workbook I wish to change this to work for Sheets in the same workbook. At present it is working for only Sheet2 of a new Workbook only. I tried to change Sheet3 Name to Sheet2 but it works only once. How can I amend it to work in the same Sheet for other subsequent Sheets? The macro should stop and ask for the new Sheet name prior to copying the snake column. Sub test() Dim first_row As Long, last_row As Long first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) Sheet1.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) Sheet1.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) first_row = last_row + 2 Wend End Sub |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Thanks - Help with Mr Doug Glancy Code - Snake Columns
Hello Doug,
It is perfect. Thanks a lot. Thats what I wanted. Rashid Khan "Doug Glancy" wrote in message ... Rashid, I believe this does what you want - allows you to name a new sheet to be added and then unsnakes to that sheet. If you enter a duplicate sheet name then you get a message and the macro exits. I hope this is what you want! Sub Test2() Dim first_row As Long, last_row As Long Dim active_sheet As Worksheet Dim mySheet As Worksheet Dim myName As String myName = Trim(InputBox("Enter the sheet name", _ "supply sheetname")) Set active_sheet = ActiveSheet Set mySheet = Worksheets.Add On Error Resume Next mySheet.Name = myName If Err < 0 Then MsgBox "That sheet name already exists" Application.DisplayAlerts = False mySheet.Delete Application.DisplayAlerts = True Exit Sub End If On Error GoTo 0 active_sheet.Activate first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(ActiveSheet.Rang e("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) ActiveSheet.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) ActiveSheet.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) first_row = last_row + 2 Wend mySheet.Activate End Sub hth, Doug Glancy "Rashid Khan" wrote in message ... Hello David, I have copied the complete macro here for you to have a look. It gives Run-time error '91' - Object variable or With block variable not set. It does not even copy the data on the Sheet2. My requirement is to have the selection to be copied to the Sheet name provided by me. The sheet should be created by the name which is supplied in the Input Box. Hope I am clear now. Any help would be appreciated Sub Test2() Dim first_row As Long, last_row As Long Dim mySheet As Worksheet Dim myName As String myName = Trim(InputBox("Enter the sheet name", _ "supply sheetname", ActiveSheet.Name)) MsgBox myName first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) ActiveSheet.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) ActiveSheet.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) first_row = last_row + 2 Wend End Sub "David McRitchie" wrote in message ... You should be identifying the line that you get the error on, but Subscript out of range is the type of error that you would get for sheet not found. Make sure that you have not introduced spaces at the end of the sheet name. Do you have something that could be interpreted by Excel as a number. By the way if you have a suggestion you can supply a default sheetname to the InputBox. myName = TRIM(InputBox("Enter the sheet name", _ "supply sheetname", activesheet.name)) msgbox myname & "<-- verify" InputBox and MsgBox http://www.mvps.org/dmcritchie/excel/inputbox.htm --- HTH, David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001] My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm Search Page: http://www.mvps.org/dmcritchie/excel/search.htm "Rashid Khan" wrote in message ... Hi Bernie, It does not work for a single sheet also. It gives the following error: Run Time Error 9 Subscript out of range What is missing? Rashid "Bernie Deitrick" <deitbe @ consumer dot org wrote in message ... Rashid, This will work on the active sheet, and ask for the name of the destination sheet. Note that there is no error checking on the input of the sheet name. HTH, Bernie MS Excel MVP Sub Test2() Dim first_row As Long, last_row As Long Dim mySheet As Worksheet Dim myName As String myName = InputBox("Enter the sheet name") Set mySheet = Worksheets(myName) first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) ActiveSheet.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) ActiveSheet.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2) first_row = last_row + 2 Wend End Sub "Rashid Khan" wrote in message ... Note: I had already posted it but no reply was received so I am reposting under a different subject Hello All, I am using Office XP and the following macro was posted by Mr. Doug Glancy to my previous question about Snake Columns. The macro works perfect but every time I have to make a new Workbook I wish to change this to work for Sheets in the same workbook. At present it is working for only Sheet2 of a new Workbook only. I tried to change Sheet3 Name to Sheet2 but it works only once. How can I amend it to work in the same Sheet for other subsequent Sheets? The macro should stop and ask for the new Sheet name prior to copying the snake column. Sub test() Dim first_row As Long, last_row As Long first_row = Selection.Rows(1).Row last_row = first_row While last_row < Selection.Rows(Selection.Rows.Count).Row last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _ first_row).End(xlDown).Row, _ Selection.Rows(Selection.Rows.Count).Row) Sheet1.Range("A" & first_row & ":A" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) Sheet1.Range("B" & first_row & ":B" & last_row).Copy _ Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) first_row = last_row + 2 Wend End Sub |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Thanks Help with Mr Doug Glancy Code - Snake Columns
Hello David,
Thanks a lot. I got the matter solved out by Mr Doug himself. Your website is like the Alibaba Treasure for novice like me. It is a wonderful site. Keep up the good work Thanks for all your time and help Rashid Khan "David McRitchie" wrote in message ... Hi Rashid, It is a lot easier to help with code if we know what it is that it is supposed to do. It appears that you want to: unsnake columns A and B from the active sheet selection to your chosen sheet. Snakes coil up and use less space, you are unsnaking rather than snaking. Actually maybe my choice of words in my snake.htm is is not very practical because interpreted literally to have a column reorganized to fit down one column on a page and then down the next column on a page would not really be in the snake's best interest as it would be chopped up to fit down each column. If that is what you want then it works, but you must include the line that was in Bernie's code; otherwide mySheet has no value. As I said if you know where you want the default to be include it in your inputbox. I don't know if activesheet is what you wanted, your indicate it is not going to sheet2 -- if you want sheet2 to be the default then use "Sheet2" including the quotes. myName = Trim(InputBox("Enter the sheet name", _ "supply sheetname", ActiveSheet.Name)) '/* -- this line was in the code that Bernie had Set mySheet = Worksheets(myName) It would also be be wise to include the following at the top of your macro: Option Explicit The other thing is from the title, it would appear that this is some kind of continuation of another thread. That really doesn't work out very well for anybody, since we don't know what was in that thread or where Doug Glancy Code fits in with this. -- HTH, David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001] My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm Search Page: http://www.mvps.org/dmcritchie/excel/search.htm "Rashid Khan" wrote in message ... Hello David, I have copied the complete macro here for you to have a look. It gives Run-time error '91' - Object variable or With block variable not set. It does not even copy the data on the Sheet2. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Hide columns code | Excel Discussion (Misc queries) | |||
Make Excel 2000 print long narrow list "snake" on wide paper? | Excel Discussion (Misc queries) | |||
Bernie, Dave, Doug, et. al. - question for you | Excel Discussion (Misc queries) | |||
Help Required With Snake Column | Excel Programming | |||
snake relocate to programmers :) | Excel Programming |