How to copy large block of cells but paste into one column

[Craig]

Hi

How can I take a large block of data (A1:Y300 which is 24 cols, 300 rows or
7200 cells of data) and paste that data into another sheet but only into one
column (so I get the 7200 data cells all in one column from say B1:B7200.

thank you!!

Craig

 

[Jarek Kujawa]

Sub zalatw()
'just qiuck and dirty
'1. select yr range A1:Y300 first
'2. copy it and paste special with TRANSPOSE to another location
'3. Select the range you have pasted
'4. run the macro

Sheets("Sheet2").Columns(2).ClearContents

With ActiveSheet
For i = 0 To Selection.Columns.Count - 1
For j = 1 To Selection.Rows.Count
counter = counter + 1
Sheets("Sheet2").Cells(licznik, 2) = Selection.Cells(counter)
Next j
Next i

'Optional: 5. delete transposed range
'Selection..ClearContents

End With
End Sub


HIH

 

[Jarek Kujawa]

oops

this one is better


Sub zalatw()
'just qiuck and dirty
'1. select yr range A1:Y300 first
'2. run the macro
'3. result will be inserted into Sheet2


Sheets("Sheet2").Cells.ClearContents

Selection.Copy
col = Selection.Columns.Count
roww = Selection.Rows.Count

Sheets("Sheet2").Range("D1").PasteSpecial Paste:=xlValues,
Transpose:=True

Sheets("Sheet2").Range(Range("D1"), Range("D1").Offset(col - 1, roww -
1)).Select

With Selection
For i = 0 To Selection.Columns.Count - 1
For j = 1 To Selection.Rows.Count
counter = counter + 1
Sheets("Sheet2").Cells(counter, 2) = Selection.Cells(counter)
Next j
Next i

Sheets("Sheet2").Range(Range("D1"), Range("D1").Offset(col - 1, roww -
1)).ClearContents

Application.CutCopyMode = False

End With
End Sub

 

[Gord Dibben]

Craig

That would 25 cols and 300 rows for 7500 cells.

Sub ToOneColumn()
Dim cntI As Integer
Dim cntJ As Integer
Dim TotalRows As Integer
Dim TotalCols As Integer
With Range("A1:Y300")

TotalRows = .Rows.Count
TotalCols = .Columns.Count

End With

For cntJ = 2 To TotalCols

Cells(1, cntJ).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Cells((cntJ - 1) * TotalRows + 1, 1).Select
ActiveSheet.Paste

Next cntJ

Cells(1, 1).Select

End Sub


Gord Dibben MS Excel MVP