append all instead of one

M

Maarkr

I've got this code to append cell data to the right of the selected cell

ActiveCell.Value = ActiveCell.Value & " " & ActiveCell.Offset(0, 1).Value

THis code only works for a single selected cell... not multiple cells.
I want to be able to select the entire column A (not just a single cell in
col a) or multiple cells and have all cells in B append into A.

thanks
 
O

Otto Moehrbach

Something like this perhaps. Otto
Sub DoIt()
Dim i As Range
For Each i In Selection
i = i & " " & i.Offset(0, 1).Value
Next i
End Sub
 
M

Mike H

Hi,

loop through the range

Sub sonic()
Dim LastRow As Long
Dim MyRange As Range, c As Range
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = Range("A1:A" & LastRow)
For Each c In MyRange
c.Value = c.Value & c.Offset(, 1).Value
Next
End Sub

Mike
 
R

Ryan H

You can try using a loop. Just adjust the code below to your applicaiton by
adjusting the Sheet name and start of range.

Option Explicit

Sub AppendCells()

Dim lngLastRow As Long
Dim rng As Range

With Sheets("Sheet1")

lngLastRow = .Cells(Rows.Count, "A").End(xlUp).Row

For Each rng In .Range("A1:A" & lngLastRow)
rng.Value = rng.Value & " " & rng.Offset(0, 1).Value
Next rng
End With

End Sub

Hope this helps! If so, click "YES" below.
 
M

Mike H

oops,

Missed the space

Sub sonic()
Dim LastRow As Long
Dim MyRange As Range, c As Range
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = Range("A1:A" & LastRow)
For Each c In MyRange
c.Value = c.Value & " " & c.Offset(, 1).Value
Next
End Sub

Mike
 
R

Ryan H

Or if you wish to select the cells you wish to append use this code below.
Option Explicit

Sub AppendCells()

Dim rng As Range

For Each rng In Selection
rng.Value = rng.Value & " " & rng.Offset(0, 1).Value
Next rng

End Sub

Hope this helps! If so, click "YES" below.
 
Top