Move data in column to another column

[spraggn]

Hi

I am new to VBA and any help with the following would be greatly appreciated.

I have the following data setup

A B C D
0.001 0.006 0.011 0.016
0.003 0.008 0.013 0.018
0.006 0.011 0.016 0.021
0.009 0.014 0.019 0.024
0.012 0.017 0.022 0.027
0.015 0.02 0.025 0.03
0.018 0.023 0.028 0.033
0.021 0.026 0.031 0.036
0.024 0.029 0.034 0.039
0.027 0.032 0.037 0.042
0.03 0.035 0.04 0.045
0.033 0.038 0.043 0.048
0.036 0.041 0.046 0.051
0.039 0.044 0.049 0.054
0.042 0.047 0.052 0.057
0.045 0.05 0.055 0.06
0.048 0.053 0.058 0.063
0.051 0.056 0.061 0.066
0.054 0.059 0.064 0.069
0.057 0.062 0.067 0.072

I would like to move the data in each of the columns to column A starting at the next free row in column A. ie move the column b data to column A in the next row after the .0057 value then move the column c data to under the .0062 value and so on. I would like to do this for all columns that have data.

A
0.001
0.003
0.006
0.009
0.012
0.015
0.018
0.021
0.024
0.027
0.03
0.033
0.036
0.039
0.042
0.045
0.048
0.051
0.054
0.057
0.006
0.008
0.011
0.014
0.017
0.02
0.023
0.026
0.029
0.032
0.035
0.038
0.041
0.044
0.047
0.05
0.053
0.056
0.059
0.0620.011
0.011

etc

Thanks

Nick[/img]

 

[tactps]

Welcome.

Not the most efficient, but will work ok:

Sub moveit()
Counter = 2
Do Until Counter = 5 'change this to the number of the last column
[a1].Offset(0, Counter - 1).Select
Range(Selection, Selection.End(xlDown)).Copy
[a65536].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Counter = Counter + 1
Loop
Application.CutCopyMode = False
Range("B:E").EntireColumn.Delete 'Change this range reference as required
[a1].Select
End Sub

 

[Nimrod]

Does all the columns of data start in row 1 ?
Is all the data numbers ?
Is the data constant or formula based ?

 

[Nimrod]

ASSUMPTIONS
1- Sheet is active
2- all values are constants
3- all values are numbers
4- all column values start in row 1

Public Sub MoveData()
 For Each ColOfNums In Rows("1:1").SpecialCells(xlCellTypeConstants, 1)
    If ColOfNums.Column > 1 Then
        ColOfNums.EntireColumn.SpecialCells(xlCellTypeConstants, 1).Cut
        ActiveSheet.Paste Destination:=Range("A" & Cells(65536, 1).End(xlUp).Row + 1)
    End If
 Next ColOfNums
End Sub

 

[spraggn]

Thanks tactps for your help. it did the job and has saved me heaps of time!!

thanks also Nimrod for your reply

cheers

Nick