copy and insert cells with macro

  • Thread starter Thread starter Guest
  • Start date Start date
G

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
 
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
 
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.
 
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 =
 
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
 
Back
Top