• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

copy cell value in a range and paste specific numberof rows below

abdulncr

Member
Dear Friends,
I am trying to write a code to copy cell value in a range if not equal to blank and paste below16 rows from active cell,after pasting one value it should go to next value in the range and do the same.
below code is doing the first task and not going next value. sample file is attached here with. can you guide me where I am wrong.


Code:
Sub PROCESS()

Dim rng As Range, cell As Range

Set rng = Range(Cells(4, 5), Cells(1000, 5))

For Each cell In rng

If cell.Value <> "" Then
  cell.Select
  cell.Copy
  Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(16, 0)).Select
  ActiveSheet.Paste
End If

Next cell

End Sub
 

Attachments

  • Sample.xlsm
    15.2 KB · Views: 1
Hi,

Try it this way:
Code:
Sub PROCESS()

    Dim rng, c As Range
    Set rng = Range(Cells(1, 1), Cells(1, 10))
   
    For Each c In rng
        If c <> "" Then
            c.Copy c.Offset(16)
        End If
    Next c

End Sub

On a side note, try to avoid the ".select" in the future as it is unnecessary (in most cases) and slows the execution of the subroutine.
Change the range as necessary.
 
Dear PCosta,
Thanks for your reply.
it is pasting value of row 9 in entire row.
I wanted to paste value of 9 in below 16 times, then there is value in 62, that also to be copied and pasted just below 16 times.. and so on.
Hope I conveyed correctly.

Thanks
Abd
 
Dear PCosta,
Thanks for your reply.
it is pasting value of row 9 in entire row.
I wanted to paste value of 9 in below 16 times, then there is value in 62, that also to be copied and pasted just below 16 times.. and so on.
Hope I conveyed correctly.

Thanks
Abd
Hi,

I see... totally misunderstood the requirement!
This should do it:
Code:
Sub PROCESS()

    Dim i As Integer
  
    For i = 1000 To 4 Step -1
        If Cells(i, 5) <> "" Then
            Range(Cells(i + 1, 5), Cells(i + 16, 5)) = Cells(i, 5)
        End If
    Next i

End Sub

Hope it helps
 
Back
Top