Hello,
I'm trying to loop this: copy each cell in column A that is selected,
paste to Sheet2's A1, print. Loop until all selected cells are copied
to Sheet2.

How do u improve this code so that even if other users mistakenly
highlight the entire row, the rng = selection.cells would only be the
data within column A and not the entire row?

Set rng = Selection.Cells

For Each cell In rng
cell.Copy
Sheets("Sheet2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Next cell

Thanks!
Aria :)

*** Sent via Developersdex http://www.developersdex.com ***

Set Rng = nothing
on error resume next
Set rng = intersect(Selection.Cells, activesheet.range("A:A"))
on error goto0

if rng is nothing then
msgbox "nothing in column A selected"
exit sub '???
end if

with worksheets("Sheet2")
for each cell in rng.cells
cell.Copy _
destination:=.Range("A1")
with .range("a1")
.value = .value
end with
.printout copies:=1, collate:=true
next cell
end with

=====
If all you needed was the value copied to A1 of Sheet2, you could use:

with worksheets("Sheet2")
for each cell in rng.cells
.range("a1").value = cell.value
.printout copies:=1, collate:=true
next cell
end with



Aria wrote:

Hello,
I'm trying to loop this: copy each cell in column A that is selected,
paste to Sheet2's A1, print. Loop until all selected cells are copied
to Sheet2.

How do u improve this code so that even if other users mistakenly
highlight the entire row, the rng = selection.cells would only be the
data within column A and not the entire row?

Set rng = Selection.Cells

For Each cell In rng
cell.Copy
Sheets("Sheet2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Next cell

Thanks!
Aria :)

*** Sent via Developersdex http://www.developersdex.com ***

--

Dave Peterson

Hi Dave,
I've taken your solution...I need your modification help please.

Could the msgbox be replaced with...If any of the user's selection
(users would CTRL and pick their rows) within column A is blank, then
don't copy it and move to the next selection. Currently, this code
copies the blank space.

If a user selects any cells along a row (but doesn't highlight column
A), how do i set rng to still point back to column A? This is rather
handy so I don't have to remind users to always highlight the entire row
or always select within column A.

Thanks so much,
Aria :)


Set rng = Nothing
On Error Resume Next
Set rng = Intersect(Selection.Cells, ActiveSheet.Range("A:A"))
On Error GoTo 0

If rng Is Nothing Then
MsgBox "nothing in column A selected"
Exit Sub '???
End If

With Worksheets("sheet2")
For Each cell In rng.Cells
.Range("A1").Value = cell.Value
.PrintOut copies:=1, collate:=True
Next cell
End With



*** Sent via Developersdex http://www.developersdex.com ***

Set rng = Nothing
On Error Resume Next
Set rng = Intersect(Selection.entirerow, ActiveSheet.Range("A:A"))
On Error GoTo 0

If rng Is Nothing Then
'this shouldn't happen--if a cell is selected, then extending that
'selection to the entire row will include column A.
MsgBox "nothing in column A selected"
Exit Sub '???
End If

With Worksheets("sheet2")
For Each cell In rng.Cells
if trim(cell.value) = "" then
'skip it
else
.Range("A1").Value = cell.Value
.PrintOut copies:=1, collate:=True
end if
Next cell
End With

Aria wrote:

Hi Dave,
I've taken your solution...I need your modification help please.

Could the msgbox be replaced with...If any of the user's selection
(users would CTRL and pick their rows) within column A is blank, then
don't copy it and move to the next selection. Currently, this code
copies the blank space.

If a user selects any cells along a row (but doesn't highlight column
A), how do i set rng to still point back to column A? This is rather
handy so I don't have to remind users to always highlight the entire row
or always select within column A.

Thanks so much,
Aria :)

Set rng = Nothing
On Error Resume Next
Set rng = Intersect(Selection.Cells, ActiveSheet.Range("A:A"))
On Error GoTo 0

If rng Is Nothing Then
MsgBox "nothing in column A selected"
Exit Sub '???
End If

With Worksheets("sheet2")
For Each cell In rng.Cells
.Range("A1").Value = cell.Value
.PrintOut copies:=1, collate:=True
Next cell
End With

*** Sent via Developersdex http://www.developersdex.com ***

--

Dave Peterson

Dave,
This is absolutely amazing! You're a godsend. This is exactly what I
neeeded. I owe you lots.

Aria :)


*** Sent via Developersdex http://www.developersdex.com ***