How to copy rows to another worksheet based on the contents of a column

[bmcintyre]

I'm trying to create a macro that will copy rows marked with an x in a specific colomn to a different worksheet. The user will sort data based on different criteria, mark the rows that they want to copy to a shipment worksheet with an "x" in column J. They will then click the macro button and the selected rows will be copied to the "Shipment Worksheet". Once the rows are copied the "N" in column I should be changed to a "Y". please see the attached file. Any help would be appreciated.

 

[Darius]

This may do the trick
I would like to limit the copy to unshipped registers, but I resisted to my improvement feelings

the line
If WSI.Cells(RWI, 10) = "x" Then
could be
If WSI.Cells(RWI, 10) = "x" and WSI.Cells(RWI, 9) = "N" Then

Sub copy_selected_Shipments()
Dim WSI As Worksheet, WSO As Worksheet
'I will take as granted that every set of data has a date(no blanks)
Set WSI = Sheets("Inventory")
Set WSO = Sheets("Shipment Worksheet")
RWI = 2: RWO = 4
Do
If WSI.Cells(RWI, 10) = "x" Then
WSI.Cells(RWI, 9) = "Y"
For CO = 1 To 10
WSO.Cells(RWO, CO) = WSI.Cells(RWI, CO)
Next CO
RWO = RWO + 1
End If
RWI = RWI + 1
Loop Until WSI.Cells(RWI, 2) = ""

End Sub

note: rename your sheet |Inventory, for Inventory (I think, was a mistake)

 

[Darius]

Sorry, I couldn't resist to change it, it now clear form before filling the data and change to the Shipment form afterwards

Sub copy_selected_Shipments()
Dim WSI As Worksheet, WSO As Worksheet
'I will take as granted that every set of data has a date(no blanks)
Set WSI = Sheets("Inventory")
Set WSO = Sheets("Shipment Worksheet")
'clean up the report
Range(WSO.Cells(4, 1), WSO.Cells(27, 10)).ClearContents
'copy selected items
RWI = 2: RWO = 4
Do
If WSI.Cells(RWI, 10) = "x" And WSI.Cells(RWI, 9) = "N" Then
WSI.Cells(RWI, 9) = "Y"
For CO = 1 To 10
WSO.Cells(RWO, CO) = WSI.Cells(RWI, CO)
Next CO
RWO = RWO + 1
End If
RWI = RWI + 1
Loop Until WSI.Cells(RWI, 2) = ""
WSO.Select
End Sub

 

[bmcintyre]

that works great!!!!!!!! you're awesome.......is there any way we could clear the x'es from the first sheet after the copy too???

 

[Darius]

Sorry, I missed it, just WSI.Cells(RWI, 10) = ""

Sub copy_selected_Shipments()
Dim WSI As Worksheet, WSO As Worksheet
'I will take as granted that every set of data has a date(no blanks)
Set WSI = Sheets("Inventory")
Set WSO = Sheets("Shipment Worksheet")
'clean up the report
Range(WSO.Cells(4, 1), WSO.Cells(27, 10)).ClearContents
'copy selected items
RWI = 2: RWO = 4
Do
If WSI.Cells(RWI, 10) = "x" And WSI.Cells(RWI, 9) = "N" Then
WSI.Cells(RWI, 9) = "Y"
For CO = 1 To 10
WSO.Cells(RWO, CO) = WSI.Cells(RWI, CO)
Next CO
WSI.Cells(RWI, 10) = ""
RWO = RWO + 1
End If
RWI = RWI + 1
Loop Until WSI.Cells(RWI, 2) = ""
WSO.Select
End Sub

 

[Steve Prevette]

Copy, "paste special", transpose may be of assistance.

 

[bmcintyre]

you are the best it works great thank you very much for all of your help