# Copy data next to a cell and paste it below

Solved/Closed
kent5244 - May 6, 2010 at 09:58 PM
kent5244 - May 7, 2010 at 10:49 AM
Hi, everyone

I am a newbie in here, and I hope some one can help me solve this:

I having a data such as the following

cell | A | B | C
----------------------------------------------------
1 | Hi | Hello | Morning
2 | Help | Please |
3 | Thanks | See you | Bye

i need to make this data to become this format

cell | A | B | C
---------------------------------------------------
1 | Hi | Hello | Morning
2 | | Morning |
----------------------------------------------
3 | Help | Please |
----------------------------------------------
4 | Thanks | See you | Bye
5 | | Bye |
----------------------------------------------

I realize that some conditions need to take into account:

To check whether C1 contains data or not,

1) if yes, copy the data into cell B2 (a cell relatively left and below C1)
Then underline continuosly below cell B2

2) if no, the underline and continue with the next row

3) continue until the last cell that contains data

Thanks

Regards
Kent

## 3 responses

venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
May 6, 2010 at 10:34 PM
first copy the data in sheet2 .

then try the macro "test"

```Sub test()
Dim j As Integer, k As Integer
Worksheets("sheet1").Activate
j = Range("A1").End(xlDown).Row
For k = j To 1 Step -1
If Cells(k, "C") <> "" Then
If k = 1 Then
Cells(k + 1, "A").EntireRow.Insert
Cells(k, "c").Cut Cells(k + 1, "B")
Cells(k + 2, "A").EntireRow.FormulaArray = "'-----------------"
Exit Sub
End If
Cells(k, "A").EntireRow.Insert

Cells(k + 1, "C").Cut Cells(k + 2, "B")
Cells(k + 3, "A").EntireRow.FormulaArray = "'-----------------"

Else
Cells(k, "A").EntireRow.Insert
Cells(k + 2, "a").EntireRow.FormulaArray = "'-----------------"

End If
Next k

End Sub```

```Sub undo()
Worksheets("sheet1").Cells.Clear
Worksheets("sheet2").Cells.Copy Worksheets("sheet1").Range("A1")
End Sub
```

sorry there will be bug ignore solution
kent5244 Posts 1 Registration date Thursday May 6, 2010 Status Member Last seen May 7, 2010
May 7, 2010 at 12:58 AM
Thanks vekat1926, your solution really helped me a lot. but there is a problem in running the data more than 3 rows. I hope to get a program which able to run continuosly until the last data.
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
May 7, 2010 at 05:19 AM
the solution I have given may even otherwise give bug. so I said at the end of the message ignore solution. I shall think about a valid solution
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
May 7, 2010 at 06:41 AM
Try this
Assumptions:
1. Record start from Row 1

```Sub MoveAndFormat()
Dim lMaxRows As Long 'max rows in the sheet
Dim lThisRow As Long 'row being processed
Dim iMaxCol As Integer 'max used column in the row being processed

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

lThisRow = 1 'start from row 1

Do While lThisRow <= lMaxRows

iMaxCol = Cells(lThisRow, Columns.Count).End(xlToLeft).Column

If (iMaxCol > 2) Then
Rows(lThisRow + 1 & ":" & lThisRow + 1).Insert
Range(Cells(lThisRow, 3), Cells(lThisRow, iMaxCol)).Copy
Range("B" & lThisRow + 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Rows(lThisRow + 1).Select

Range(Cells(lThisRow, 3), Cells(lThisRow, iMaxCol)).Clear
lThisRow = lThisRow + 1
lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row

Else
Rows(lThisRow).Select

End If

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlDash
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With

lThisRow = lThisRow + 1
Loop
End Sub```
thanks for your prompt reply. from your solution, i can learn how to use the loop function as well, thanks a lot. ^^