View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
john john is offline
external usenet poster
 
Posts: 97
Default HELP----Row cut and Paste

Here's a good start. Still need to refine the skip to new
sheet (beyond one extra). This assumes all blocks of data
start in column A on sheet "input", and you have
sheets "outpu1" and "output2" created.

John

Sub Macro1()
'
Sheets("input").Select
Dim lastrow As Integer
Dim firstrow As Integer
Dim totalcols As Integer
Dim Blockrows(100) As Integer
Dim Blockrowcols(100, 20) As Integer
Dim Block(100, 100, 20) As Variant
Dim k As Integer
Dim i As Integer
Dim m As Integer
Dim j As Integer
'
'Allow up to 300 rows of data in Column A
Cells(1, 1).Offset.End(xlDown).Select
firstrow = ActiveCell.Row
Cells(300 + firstrow, 1).Offset.End(xlUp).Select
lastrow = ActiveCell.Row
'
' there are k blocks of data
' each with any number of rows (j) and up to 20 columns (m)
'
k = 1
'
i = firstrow
newBlock:
'
'Count the number of rows of data for this Block
'
Blockrows(k) = -(Cells(i, 1).Row - _
Cells(i, 1).Offset.End(xlDown).Row) + 1
'
For j = 1 To Blockrows(k)
'
'Count the number of columns of data for this row
'
Blockrowcols(k, j) = -(Cells(i, 1).Column - _
Cells(i, 1).Offset.End(xlToRight).Column) + 1
For m = 1 To Blockrowcols(k, j)
Block(k, j, m) = Cells(i, m).Value
Next m
If i = lastrow Then GoTo alldone
i = i + 1
Next j
If i = lastrow Then GoTo alldone
k = k + 1
'
' Find next Block with unknown number of rows gap
'
i = i - (Cells(i, 1).Row - _
Cells(i, 1).Offset.End(xlDown).Row)
GoTo newBlock
alldone:
Cells(1, 1).Select
'
' Put data onto new sheet with each Block in a new column
'
Sheets("output1").Select
'
' Data is in Block(Block, Row, Column)
' # of Rows for each Block is in Blockrows(Block)
' # of Columns for each row is in Blockrowcols(Block, Row)
' i is counter for blocks, j for block rows, and for
blockrowcols
'
For i = 1 To k
Sheets("output1").Select
totalcols = 0
For j = 1 To Blockrows(i)
' Check to see if next row of data fits on sheet
If totalcols + Blockrowcols(i, j) < 256 Then GoTo sheetokay
Sheets("output2").Select
totalcols = 0
sheetokay:
For m = 1 To Blockrowcols(i, j)
Cells(i, m + totalcols).Select
Cells(i, m + totalcols).Value = Block(i, j, m)
Next m
' Keep running total of columns in row
' Leave empty column before next row of data
totalcols = totalcols + m
Next j
Next i
Cells(1, 1).Select
End Sub

-----Original Message-----
I have an Excel spreadsheet that contain several blocks

of data. Each
block contain a random number of rows but each row have a

maximum of
twenty columns.

I need to transfer the data from each block and row by

row by Cut and
paste. There are many blocks and a macro is required. My

major
difficulty is that the rows in one block must be

transferred to a
single row, separated by a blank column, prior to pasting

the next row
and so on. The next block should be paste into row two

and repeat until
the entire blocks are transfered. An additional problem

that might
arise is that if one block requires more that 256 column,

then the
additional row must be pasted on sheet two, or three if

need.

Any advice..... All are appreciated.


---
Message posted from http://www.ExcelForum.com/

.