Copy The Selected Row

[adam]

HI anyone,

How could the following code be adjusted so that it copies the selected row from columns F to I and paste them in from column C to F of the OrderData Sheet with the cell content of O6 being copied to the column B of the row where the rest of the data gets copied.

Any help on this would be kindly appreciated.

Thanks in advance.

Code: Select all

Sub copyrow()
Dim myrow As Integer
myrow = ActiveWindow.RangeSelection.Row
Rows(myrow).Select      'This copies the selected row
Selection.Copy
ActiveSheet.Paste Destination:=Worksheets("OrderData").Cells(3, 1)
Application.CutCopyMode = False
End Sub

[HansV]

Code: Select all

Sub CopyRow2()
  Dim myrow As Long
  myrow = ActiveWindow.RangeSelection.Row
  ActiveSheet.Range("F" & myrow & ":I" & myrow).Copy Destination:=Worksheets("OrderData").Range("C3")
  ActiveSheet.Range("O6").Copy Destination:=Worksheets("OrderData").Range("B3")
  Application.CutCopyMode = False
End Sub

[adam]

Thanks for the help Hans. My column Headers in Sheet "OrderData" starts from row 4 onwards.

How could the code be made so that it would copy the selected rows from the active sheet and keep on pasting them from row 5 onwards.

Lets say for example if the value on O6 is 0002 and the column B of the sheet has a row with 0002, the code would paste the copied row below the row containg 0002.

I hope I've made my question clear.

Any help on this would be kindly appreciated.

Thanks in advance.

[HansV]

I don't understand how that would work. What if there are already other data "below the row containg 0002"?

[adam]

The code could add a row and paste the data.

[HansV]

Does this do what you want?

Code: Select all

Sub CopyRow2()
  Dim myrow As Long
  Dim wsh As Worksheet
  Dim rng As Range
  Dim r As Long
  myrow = ActiveWindow.RangeSelection.Row
  Set wsh = Worksheets("OrderData")
  Set rng = wsh.Range("B:B").Find(What:=Range("O6").Value, LookIn:=xlValues, LookAt:=xlWhole)
  If rng Is Nothing Then
    r = wsh.Range("B" & wsh.Rows.Count).End(xlUp).Row + 1
  Else
    rng.Offset(1, 0).EntireRow.Insert
    r = rng.Row + 1
  End If
  ActiveSheet.Range("F" & myrow & ":I" & myrow).Copy Destination:=Worksheets("OrderData").Range("C" & r)
  ActiveSheet.Range("O6").Copy Destination:=Worksheets("OrderData").Range("B" & r)
  Application.CutCopyMode = False
End Sub

[adam]

I'm getting a debug message by highlighting the following line.

r = wsh.Range("B" & wsh.Rows.Count).End(xlUp).Row + 1

[HansV]

Sorry, I don't know how that error got into the code. Change


Dim r As RoutingSlip

to

Dim r As Long

[adam]

The code now copies the row. But it does not insert a row above the row that contains another number such as other than 0002.
Instead it copies the row to the first empty row below the last data row?

How can this be prevented?

[HansV]

Apparently the code doesn't find 0002. I cannot tell you why, you'll have to look carefully at your data.

[adam]

If the macro is run by selecting more than one row the code does not copy all the rows. Instead it copies only the first selected rows.

How can it be made to work with multiple rows?

[HansV]

Loop through the selected rows and handle each as in the current code.

[adam]

like how?

[HansV]

I'll let you find out for yourself for once.

[adam]

Thanks for the help Hans. I guess I've found out.

[adam]

I've inserted the following line to the code at Post 42131 just above the End Sud, so that the row gets copied to the appropriate row of the "OrderData" sheet.

Code: Select all

Sheets("OrderData").Range("B5:H" & Sheets("OrderData").Range("B" & Rows.Count).End(xlUp).Row).Sort Key1:=Sheets("OrderData").Range("B5"), Order1:=xlAscending

My question of concern is, Instead of having the user to select the row to be copied; how could the code be made so that it copies the rows within the range F18: O37 that is being highlighted with Interior.ColorIndex = 6.

Any help on this would be kindly appreciated.

Thanks in advance.

[HansV]

Loop through the rows and inspect Interior.ColorIndex of each row. If it is equal to 6, copy the row.