Copy/paste non-contiguous cells-but same row -- into diff wrksht,sme workbk - nxt empty row
Posted by Laura leigh on January 25, 2002 12:39 PM
I have a workbook that I am having some MAJOR work redundacnies on and I can't (for the life of me) find
out how to do this simple task.
here goes...
I have a row where the last column asks a question-
answer is Y or N. If the answer is y, then I want the
code to copy the values(in the same row) from columns a, b, e, h, and l. Then paste them into sheet3.
We'll call the first worksheet: sheet1(for testing purposes). I know that using Ctrl to select non-contiguous cells in Excel - then - copying/pasting them puts them contiguously into the pasted locations. That's what I want to happen, so no prob.
It will go into the next empty row & start @ column A is fine!
Please, can anyone help?????
Thank you SO - So - SO MUCH!!
laura
Posted by Joe Was on January 25, 2002 2:41 PM
I did not have time to taylor this code to your needs, but it is commented and just about does what you want. You need to change the sheet names to yours, the copy flag is "X" and not your "y" the code copies a row range, you need individual cells, a quick change. Just re-do the copy/paste block for each additional range. JSW
Sub Priority()
'Find all the rows ("A:G") that have a "X" in column "A" copy
'that row to the next blank row on a different sheet.
Application.ScreenUpdating = False
Worksheets("Want_Full").Select
For Each r In Worksheets("Want_Full").UsedRange.Rows
n = r.Row
'"Want_Full" is the first sheet, the number in "Cells" is the column of the test.
If Worksheets("Want_Full").Cells(n, 1) = "X" Then
Worksheets("Want_Full").Range(Cells(n, 2), Cells(n, 7)).Copy Destination:=Worksheets("Want_Now").Range("B65536").End(xlUp).Offset(1, -1)
Else
End If
Next r
'This optional code replaces the copy flag, like a re-set.
Worksheets("Want_Full").Columns("A").Replace What:="X", Replacement:="*", SearchOrder:=xlByColumns, MatchCase:=True
ActiveWindow.ScrollRow = 22
ActiveWindow.SmallScroll Down:=19
Range("Vendor").Select
Selection.Copy
Sheets("Want_Full").Select
ActiveWindow.ScrollRow = 1
Range("A1").Select
Sheets("Want_Now").Select
Range("B65536").End(xlUp).Offset(2, -1).Select
ActiveSheet.Paste
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True
End Sub
