I copied what you wrote and renamed sheet2 to DRMO SHEET but nothing
happened. I took what you already showed me yesterday and I can get one
row to the sheet with this:

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

Set actWks = ActiveSheet
Set prtWks = Worksheets("DRMO SHEET")

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

With prtWks
For Each myCell In myRng.Cells
iRow = myCell.Row
.Range("a6").Value = actWks.Cells(iRow, "a").Value
.Range("e6").Value = actWks.Cells(iRow, "z").Value
Application.Calculate
Application.Goto .Range("a1"), scroll:=True
Next myCell
End With
End Sub


Dave Peterson Wrote:
Maybe something like:

Option Explicit
Sub testme2()
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("Sheet1")

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, "z").Value
Next myCell
End With
End Sub

I'm guessing that z12 meant column Z.


--
Optitron
------------------------------------------------------------------------
Optitron's Profile: http://www.excelforum.com/member.php...o&userid=26729
View this thread: http://www.excelforum.com/showthread...hreadid=399813

I had a mistake in today's code. I pasted to the bottom of sheet2 column A.
But then I didn't go to the next cell.

Option Explicit
Sub testme2()
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("Sheet1")

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, "z").Value
'I added this to go down one row.
Set DestCell = Destcell.offset(1,0)
Next myCell
End With
End Sub

It does assume that the cell in column A of the input worksheet is not empty!



Optitron wrote:

I copied what you wrote and renamed sheet2 to DRMO SHEET but nothing
happened. I took what you already showed me yesterday and I can get one
row to the sheet with this:

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

Set actWks = ActiveSheet
Set prtWks = Worksheets("DRMO SHEET")

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

With prtWks
For Each myCell In myRng.Cells
iRow = myCell.Row
Range("a6").Value = actWks.Cells(iRow, "a").Value
Range("e6").Value = actWks.Cells(iRow, "z").Value
Application.Calculate
Application.Goto .Range("a1"), scroll:=True
Next myCell
End With
End Sub

Dave Peterson Wrote:
Maybe something like:

Option Explicit
Sub testme2()
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("Sheet1")

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, "z").Value
Next myCell
End With
End Sub

I'm guessing that z12 meant column Z.

--
Optitron
------------------------------------------------------------------------
Optitron's Profile: http://www.excelforum.com/member.php...o&userid=26729
View this thread: http://www.excelforum.com/showthread...hreadid=399813

--

Dave Peterson

Ok it's working. It put the data on the next page down. It's all good
now. Thanks.

Dave Peterson Wrote:
I had a mistake in today's code. I pasted to the bottom of sheet2
column A.
But then I didn't go to the next cell.

Option Explicit
Sub testme2()
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("Sheet1")

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, "z").Value
'I added this to go down one row.
Set DestCell = Destcell.offset(1,0)
Next myCell
End With
End Sub

It does assume that the cell in column A of the input worksheet is not
empty!


--
Optitron
------------------------------------------------------------------------
Optitron's Profile: http://www.excelforum.com/member.php...o&userid=26729
View this thread: http://www.excelforum.com/showthread...hreadid=399813