copy and insert cells with macro

[Guest]

Hi All,

On Sheet1 is a range F1:R500. In some of the cells in column R is number
“1â€. What I need is to create a macro which will do the next: for every row
in range F1:R500 if the cell in column R is 1, copy cells F:R, then go to
Sheet2, insert a row, paste copied VALUES from Sheet1 in cell F1 of Sheet2
and copy the formulas from G2:L2 to G1:L1 of the same worksheet.
Any Help is highly appreciated.

Tim

 

[Guest]

Hi Tim:

Try this, although I assume that you want it pasted in the w/sheet1 in cells
F:R.
Also note that it will paste it in reverse order: If you want it in the same
order change for for loop to work backwards as in For lRow = 500 To 1 step -1:

Option Explicit

Sub copy4tim()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lRow As Long

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

For lRow = 1 To 500
If ws1.Cells(lRow, "R") = 1 Then
ws2.Rows(1).Insert
' this is unclear may need to
' modify as you sayu paste into F1 only.
ws1.Range(Cells(lRow, "F"), _
Cells(lRow, "R")).Copy ws2.Range("F1:R1")
ws2.Range("G2:L2").Copy ws2.Range("G1:L1")
End If
Next lRow

End Sub

 

[Guest]

Hi Tim,

Most of the required code can be produced by simply recording a macro. Pick
any row you like (say row 8) and perform the actions, i.e. select F:R, copy,
switch sheets, insert row, paste values and copy the formats from the row
below

The code recorded will then be specific for row 8, e.g. Range("F8:R8").Select

Once you have this, post the code and someone will show you how to go
through the rows and find the "1"s and change the Range accordingly.

 

[mdupris]

Tim,

The first part could be handled with the following code. I'm
confused about the "copy the formulas from G2:L2 to G1:L1 of the same
worksheet" part, though.

= Marchand =

Sub copyTheOnes()

Dim iRow As Integer
Dim iDestRowOffset As Integer

iDestRowOffset = 1
For iRow = 0 To 499
If Worksheets("Sheet1").Range("F1").Offset(iRow, 0).Value = 1
Then
Worksheets("Sheet2").Rows(iDestRowOffset).Insert
Shift:=xlDown

' The '13' in the next row extends the selection to column
'R'
Worksheets("Sheet1").Range("F1").Offset(iRow, 0).Resize(1,
13).Copy
Worksheets("Sheet2").Range("F1").Offset(iDestRowOffset -
1, 0).PasteSpecial Paste:=xlPasteValues
iDestRowOffset = iDestRowOffset + 1
End If
Next iRow

End Sub

= Marchand =

 

[Guest]

It is my mistake about “copy the formulas from G2:L2 to G1:L1â€.
But your codes work great.
Thank you Martin and Marchand!

Tim