Sleeper: Do copy macro

[lorraine]

hello,

I intend to copy the value in column J to column I as long as there is value in column A. An then I do a loop.

The macro below works just fine as long as I enter the value manually one after the other in column J, pretty boring...

But when I do a copy paste value in column J of an entire column, the macro does not work the same.
Indeed it copies the value of the column J only once in column I, just like if the loop was not working anymore. Can you help me? Thanks.

I have the code below :


Sub DoCopy()
Dim Rng As Range
Dim Cel As Range
Set Rng = Columns("J:J").SpecialCells(xlCellTypeConstants, 10)
For Each Cel In Rng
i = 0
Do
i = i + 1
If Cells(Cel.Row + i, 1) <> "" Then
Cells(Cel.Row + i, 9) = Cel.Value
Else
Exit Do
End If
Loop
Next
End Sub

[Bob Phillips]

Isn't this all that you need?



Sub DoCopy()
Dim Rng As Range
Dim Cel As Range
Dim i As Long
Set Rng = Columns("J:J").SpecialCells(xlCellTypeConstants)
For Each Cel In Rng
If Cells(Cel.Row, "A").Value <> "" Then
Cells(Cel.Row + i, 9) = Cel.Value
End If
Next
End Sub

[lorraine]

Unfortunately i cannot attach a spreadsheet but i will try to be clear:

In cell A1 i have an item named "apple" then in A2 I have the text "field name" and in A3, A4 and A5 i have the names "latin america", "europe" and "US". In cell J1 I have "fruit" and I wish to have the text "fruit" in cell I2, I3, I4 and I5 (so i want to copy J1 into I2, I3, I4, and I5).

The same way in cell A7 I have the item "tomato" and I have "vege" in cell J7, I want to copy J7 into cell I8 and I9.

This goes on with different item to cell A 4500. This is the reason why i need a loop.

I have copy pasted value my column J and thus i get J1 copied only in cell I2 while I3, I4 and I5 are left blank. I dentically for cell J7 that is copied into the cell I8 but I9 has been left blank.

If I enter J1 and J7 manually, the macro works fine, but i work with too many data to enter them manually.

[Bob Phillips]

Sub DoCopy()
Dim Rng As Range
Dim Cel As Range
Dim NumRows As Long
Dim i As Long
Set Rng = Columns("J:J").SpecialCells(xlCellTypeConstants)
For Each Cel In Rng
If Cells(Cel.Row, "A").Value <> "" Then
NumRows = Range(Cells(Cel.Row, "A"), Cells(Cel.Row, "A").End(xlDown)).Rows.Count
Cells(Cel.Row + i, 9).Resize(NumRows).Value = Cel.Value
End If
Next
End Sub

[lorraine]

well that is not exactly what i meant but i guess it is too difficult to understand without a spreadsheet.
Thanks a lot for your help, i will try to reuse your code and modify it a bit. Cheers.

[Bob Phillips]

You should be able to post a spreadsheet now, you have 5 posts.