View Single Post
  #1   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

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