vba code for remove blank cells

[abbccc]

I want remove blank cells column a and show result in column b
please give me a vba code
for example
remove blank.jpg

[GarysStudent]

Try this:

Sub dural()
Dim N As Long, NN As Long, K As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
K = 1
For NN = 1 To N
    If Cells(NN, 1) <> "" Then
        Cells(K, 2) = Cells(NN, 1)
        K = K + 1
    End If
Next
End Sub

[HaHoBe]

Hi, abbccc,

if the shown are values (no formulas) you may shorten the loop to only those cells with values like

Sub abbccc_2()
    Dim rngCell As Range
    Dim lngTarg As Long
    lngTarg = 1
    For Each rngCell In Range("A:A").SpecialCells(xlCellTypeConstants, 23)
        Cells(lngTarg, 2) = rngCell
        lngTarg = lngTarg + 1
    Next rngCell
End Sub

Ciao,
Holger

[abbccc]

Thank you HaHoBe
Thank you GarysStudent

[shrivallabha]

Or non-looper [frequently shown by snb]

Option Explicit
Public Sub GetNonBlanks()
Dim r As Range
Dim v As Variant
Set r = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
v = Filter(Application.Transpose(Evaluate("=IF(" & r.Address & "<>""""," & r.Address & ",""~"")")), "~", False)
Range("B1").Resize(UBound(v) + 1, 1).Value = Application.Transpose(v)
End Sub

[Paul_Hossler]

no error checking and as is will only work with constant cells but both could easily be added

Sub test()
    Call Columns("A:A").SpecialCells(xlCellTypeConstants, 23).Copy(Range("B1"))
    Application.CutCopyMode = False
End Sub

Paul

[snb]

Sub M_snb002()
With Columns(1)
.AutoFilter 1, "<>"
.Cut Cells(1, 2)
.AutoFilter
End With
End Sub

or

Sub M_snb003()
Columns(1).SpecialCells(4).EntireRow.Delete
Columns(1).Insert
End Sub

[abbccc]

Thank you for all

[SendGroupSMS]

Is the VBA code provided in the solution worked for all the latest as well as old versions of MS Excel?

[Aussiebear]

Is the VBA code provided in the solution worked for all the latest as well as old versions of MS Excel?

Did you try it first?