copy data next to a cell and paste it belowSolved/Closed

Question

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

venkat1926 · Answer

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

venkat1926 · Answer

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 · Answer

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

Copy data next to a cell and paste it below

3 responses

Similar discussions

Subscribe To Our Newsletter!