Cut not Copy Appended Data
 

In this great Macro, created by Micky (MVP), is there a way to cut and paste
the data from all the columns instead of copy and paste? I just want all the
appended data in Column A".

Sub Tony()
Application.ScreenUpdating = False
LR = ActiveSheet.UsedRange.Rows.Count
LC = ActiveSheet.UsedRange.Columns.Count
Ind = LR + 1
For C = 2 To LC
For R = 1 To LR
If Cells(R, C) < "" Then
Cells(Ind, 1) = Cells(R, C)
Ind = Ind + 1
End If
Next
Next
Application.ScreenUpdating = True
End Sub

Cut not Copy Appended Data
 

If the order the values are pasted into column 1 don't matter (by rows
instead of by columns), then you can use:


Code:
--------------------


Sub Tony()
Dim Ind As Long, LR As Long, LC As Long
Application.ScreenUpdating = False
LR = ActiveSheet.UsedRange.Rows.Count
LC = ActiveSheet.UsedRange.Columns.Count
Ind = LR + 1
For Each ce In Range(Cells(1, 2), Cells(LR, LC))
If ce.Value < "" Then
ce.Cut Cells(Ind, 1)
Ind = Ind + 1
End If
Next ce
Application.ScreenUpdating = True
End Sub
--------------------



If order matters (need to go down each column, then across), try:


Code:
--------------------


Sub Tony2()
Dim Ind As Long, LR As Long, LC As Long
Dim C As Long, R As Long
Application.ScreenUpdating = False
LR = ActiveSheet.UsedRange.Rows.Count
LC = ActiveSheet.UsedRange.Columns.Count
Ind = LR + 1

For C = 2 To LC
For R = 1 To LR
If Cells(R, C).Value < "" Then
Cells(R, C).Cut Cells(Ind, 1)
Ind = Ind + 1
End If
Next R
Next C
Application.ScreenUpdating = True
End Sub
--------------------


--
Paul

- Paul
------------------------------------------------------------------------
Paul's Profile: 1697
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=192265

http://www.thecodecage.com/forumz

Cut not Copy Appended Data
 

Great job Paul... that did it.
Thanks!

"Paul" wrote:


If the order the values are pasted into column 1 don't matter (by rows
instead of by columns), then you can use:



Code:
--------------------



Sub Tony()
Dim Ind As Long, LR As Long, LC As Long
Application.ScreenUpdating = False
LR = ActiveSheet.UsedRange.Rows.Count
LC = ActiveSheet.UsedRange.Columns.Count
Ind = LR + 1
For Each ce In Range(Cells(1, 2), Cells(LR, LC))
If ce.Value < "" Then
ce.Cut Cells(Ind, 1)
Ind = Ind + 1
End If
Next ce
Application.ScreenUpdating = True
End Sub

--------------------



If order matters (need to go down each column, then across), try:



Code:
--------------------



Sub Tony2()
Dim Ind As Long, LR As Long, LC As Long
Dim C As Long, R As Long
Application.ScreenUpdating = False
LR = ActiveSheet.UsedRange.Rows.Count
LC = ActiveSheet.UsedRange.Columns.Count
Ind = LR + 1

For C = 2 To LC
For R = 1 To LR
If Cells(R, C).Value < "" Then
Cells(R, C).Cut Cells(Ind, 1)
Ind = Ind + 1
End If
Next R
Next C
Application.ScreenUpdating = True
End Sub

--------------------


--
Paul

- Paul
------------------------------------------------------------------------
Paul's Profile: 1697
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=192265

http://www.thecodecage.com/forumz

.