CODEWITHSUNDEEP
vbaexcel
DINESHKUMAR PALANISAMY
DINESHKUMAR PALANISAMY

Reputation: 159

copy data from a worksheet till a condition

I have a worksheet which contains data in column B to column D. I want to copy the data from B4 to till the cell value which has space infront of it and paste it in a separate sheet and change the sheet as the value B4 and then it has to copy the next cell values untill the cell value with space infront and it continues till column B has empty cells.

In addition to that i have to enter serial no in column A respect to the data without space inits intial stage. i have attached the input and expected output image for your reference.

input: enter image description here

expected output:

enter image description here

please help on this issue.

Upvotes: 0

Views: 56

Answers (1)

Mrig
Mrig

Reputation: 11702

Assuming your sheet is as follows:

enter image description here

Enter the following formula in the Cell A4

=IF(LEFT(B4,1)<>" ",COUNTA($A$2:A3)+1-COUNTBLANK($A$2:A3),"")

Drag/Copy down formula as required.

If you are looking for a VBA solution, following should work:

Sub Demo()
    Dim ws As Worksheet
    Dim lastRow As Long, index As Long, i As Long
    Dim rng As Range

    index = 1
    Set ws = ThisWorkbook.Sheets("Sheet1")   '---->change the sheet name as required
    lastRow = ws.Cells(Rows.count, "B").End(xlUp).Row
    Set rng = ws.Range("B4:B" & lastRow)
    For i = 4 To lastRow
        If Left(ws.Cells(i, 2).Value, 1) <> " " Then
            ws.Cells(i, 1).Value = index
            index = index + 1
        End If
    Next i
End Sub

_______________________________________________________________________________

EDIT 1 : First copy data from Sheet1 to Sheet2 and then add serial numbers.

Sub Demo()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow As Long, index As Long, i As Long
    Dim rng As Range

    index = 1
    Set ws1 = ThisWorkbook.Sheets("Sheet1")   '---->change the sheet name as required
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    lastRow = ws1.Cells(Rows.count, "B").End(xlUp).Row
    ws1.Range("B2:D" & lastRow).Copy Destination:=ws2.Range("B2")
    Set rng = ws2.Range("B4:B" & lastRow)
    For i = 4 To lastRow
        If Left(ws2.Cells(i, 2).Value, 1) <> " " Then
            ws2.Cells(i, 1).Value = index
            index = index + 1
        End If
    Next i
End Sub

_______________________________________________________________________________

EDIT 2 :

Sub Demo()
    Dim srcWS As Worksheet, destWS As Worksheet
    Dim lastRow As Long, index As Long, i As Long
    Dim copyRng As Range, rng1 As Range, rng2 As Range

    index = 1
    Set srcWS = ThisWorkbook.Sheets("Sheet1")   '---->change the sheet name as required
    lastRow = srcWS.Cells(Rows.count, "B").End(xlUp).Row
    Set rng1 = srcWS.Cells(4, 2)
    For i = 4 To lastRow
        If Left(srcWS.Cells(i, 2).Value, 1) <> " " Then
            srcWS.Cells(i, 1).Value = index
            index = index + 1
            If i <> 4 Then
                Set rng2 = srcWS.Cells(i - 1, 4)
                Set destWS = Sheets.Add(After:=Sheets(Sheets.count))
                srcWS.Range(rng1, rng2).Copy Destination:=destWS.Range("B4")
                Set rng1 = srcWS.Cells(i, 2)
            End If
        End If
    Next i
    Set rng2 = srcWS.Cells(lastRow, 4)

    Set destWS = Sheets.Add(After:=Sheets(Sheets.count))
    srcWS.Range(rng1, rng2).Copy Destination:=destWS.Range("B4")

End Sub

Upvotes: 1

Related Questions