I got this macro from someone in this forum. It moves two specific cell
from one row on a sheet to two cells in a row on another sheet "DRMO".
tried to modify it to move three cells but if I select more than one ro
and click the button it fills them in horizontally instead o
vertically. For this one I need; cell A to cell A, cell BW to cell E
and cell AA to cell I.


Option Explicit
Sub DRMO()
Dim toWks As Worksheet
Dim actWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim iRow As Long
Dim DestCell As Range

Set actWks = ActiveSheet
Set toWks = Worksheets("DRMO")

Set myRng = Intersect(Selection.EntireRow, actWks.Range("a:a"))

With toWks
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

With toWks
For Each myCell In myRng.Cells
iRow = myCell.Row
DestCell.Value = actWks.Cells(iRow, "a").Value
DestCell.Offset(0, 1).Value = actWks.Cells(iRow, "BW").Value
Set DestCell = DestCell.Offset(0, 1)
DestCell.Offset(0, 1).Value = actWks.Cells(iRow, "AA").Value
Set DestCell = DestCell.Offset(0, 1)
Application.Goto .Range("a1"), scroll:=True
Next myCell
End With
End Su

--
Optitro
-----------------------------------------------------------------------
Optitron's Profile: http://www.excelforum.com/member.php...fo&userid=2672
View this thread: http://www.excelforum.com/showthread.php?threadid=47551