Copy 18 Cells in one row

[AirgasRob]

Greetings and thank you for taking the time to help me.

I want to be able to go across row 1 until I meet criteria >0.
Then copy 18 cells (columns) across and paste them to row 2.
For example A10 is first cell that >0
copy that cell and the next 17 cells in that row
paste in B10 across.

The sub I was using works great but only for copying columns across.

Sub LoopCol5()
Dim RngCol5 As Range
Dim i As Range
Dim c As Long
Set RngCol5 = Range("AS4", Range("AS" & Rows.Count).End(xlUp))
For Each i In RngCol5
Select Case i.Value
Case "1": c = 10
Case Else: c = -9999
End Select
If c > -9999 Then
Cells(i.Row, 8).Value = Cells(i.Row, c).Value
End If
Next i
End Sub

 

[Rick Rothstein]

Your description is somewhat confusing. You say "go across row 1....and
paste them to row 2", but then say in your example to put A1 and next 17
cells in that row into B10??? On top of that, your example code looks like
it is iterating down a column, not across a row. Can you clarify what you
are trying to do for us?

 

[AirgasRob]

Hi Rick,
Sorry for confusion.

I would like to start in cell A1 and go across until I find >0
A1, B1, C1, ect..

If A1 is first cell >0 then copy that cell and the next 17 cells. A1:R1

Then paste values 3 rows down in this case A4:R4

 

[Rick Rothstein]

Does this do what you want?

Sub MoveFirstNonZeroPlusNext17Cells()
Dim X As Long
For X = 1 To Columns.Count - 18
If Cells(1, X).Value > 0 Then
Cells(1, X).Resize(1, 18).Copy Cells(1, X).Offset(3)
Exit For
End If
Next
End Sub