View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Rashid Khan Rashid Khan is offline
external usenet poster
 
Posts: 56
Default 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