Solved: Remove Empty Cells from Range, Copy and Paste

[brorick]

I have a range named MiddleNames and I need to copy only the cells with data and paste them to another location. Any thoughts on how to do this.

For example.

B1 = James
B2 =
B3 = Matthew
B4 = Marie
B5 =

Copy and paste as follows
AA1 = James
AA2 = Matthew
AA3 = Marie

I am not sure of the correct approach. :help

[brorick]

Ok, what I have so far is the following. The problem is it copies all of the information including the empty cells.


Dim rng as Range

Set rng = Range("MiddleNames")

rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("MiddleNames"), CopyToRange:=Range("AA1"), Unique:=False

[GTO]

Greetings brorick,

Depending on if "Middlenames" is not a real huge range, this should work.

Option Explicit

Sub COmpactData()
Dim rCell As Range
Dim arySource()
Dim i As Long

ReDim arySource(0)
For Each rCell In Range("Middlenames")
If Not rCell.Value = vbNullString Then
arySource(UBound(arySource)) = rCell.Value
ReDim Preserve arySource(UBound(arySource()) + 1)
End If
Next
ReDim Preserve arySource(UBound(arySource()) - 1)

For i = LBound(arySource()) + 1 To UBound(arySource()) + 1
Cells(i, 27).Value = arySource(i - 1)
Next
End Sub

I hope someone stops in and gives a more efficient approach, I seem to be fading thought-wise (not that I'm much better awake...)

Have a great day,

Mark

[brorick]

Mark, thank you for your help. I will give it a try.

[georgiboy]

Here would be my approach, i think it will work on a rather large range but correct me if i am wrong.


Sub CopPaste()
Dim rCell As Range
Dim x As Long

x = 1

For Each rCell In Range("MiddleNames").Cells
If rCell.Value <> "" Then
rCell.Copy Range("AA" & x)
x = x + 1
End If
Next


End Sub

Hope this helps

[mdmackillop]

Without VBA
F5 - In Reference enter C:C OK
F5 - Special/Constants/OK
Copy selected cells, select target and paste.