Automatic transfer of row info to another worksheet

[Jack Wood]

I have a worksheet in Microsoft Excel with a master list of vendors
consisting of 116 rows with the vendor's information contained in
columns B thru H of each row. In column A an x is placed for each
vendor selected that are going to be used. I want each vendor selected
to have the information contained in columns B thru H for that vendor be
automatically sent to another worksheet in the workbook called Vendor's
List while at the same time ignoring any blank spaces on the Vendor's
List. Is there a macro that can be used. I do not want to use drop
down boxes or lists.

 

[KC]

May be:

dim wsm as worksheet
dim wsv as worksheet
set wsm=sheets("Master")
set wsv=sheets("Vendor's List")

wsm.select
lrow=wsm.cells(rows.count, "B").end(xlup).row
set rng=range("A1:A" & lrow)
for each c in rng
if c="x" then
range(cells(c.row,"B"), cells(c.row,"H").copy
wsv.cells(rows.count,"B").end(xlup).offset(1,0).pastespecial
end if
next c

Not tested, adjust to suit

 

[Jack Wood]

Worked good for transferring the information from the Master List
Worksheet to the Vendor List worksheet, but now the Vendor List
worksheet displays blank rows where a vendor was not selected from the
Master List. How can I get the Vendor List not to display blank rows.

 

[Gord Dibben]

KC's code should not leave any blank rows in Vendor's List.

First Master sheet c.row with an "x" will be in row 2 of Vendor's List

The rest will be in contiguous rows from there down.

BTW..............I added the missing paren in this line.

Range(Cells(c.Row, "B"), Cells(c.Row, "H")).Copy

Also add this line just before End Sub

Application.CutCopyMode = False



Gord Dibben MS Excel MVP

 

[Jack Wood]

This is not working. Get an error message indicating that there is a
Compile Error: Invalid Outside Procedure. It will not accept the
command of "Set". Also I am not sure the statement "If C = "x" Then" is
correct. Column A is where the "x" is placed.

 

[Gord Dibben]

The "c" is just a cell in column A

For Each c In rng..............rng has been set to Range("A1:A" & lrow)

lrow has been stored as last row with data in column B

lrow = wsm.Cells(Rows.Count, "B").End(xlUp).Row

Where did you store the code?

Copy this revision to a General Module in your workbook.

Option Explicit
Sub copy_things()
Dim wsm As Worksheet
Dim wsv As Worksheet
Dim c As Range
Dim lrow as Long
Set wsm = Sheets("Master")
Set wsv = Sheets("Vendor's List")

wsm.Select
lrow = wsm.Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Range("A1:A" & lrow)
For Each c In rng
If c = "x" Then
Range(Cells(c.Row, "B"), Cells(c.Row, "H")).Copy
wsv.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next c
Application.CutCopyMode = False

End Sub


Gord

 

[Jack Wood]

Still does not work. Is there anyway I can send you my Workbook?

 

[Patrick Molloy]

something like this to get you started. If there's an x in column A then
columns B-H are copied to the target sheet columns A-G

Option Explicit
Sub CopyVendors()
Dim cell As Range
Dim targetRow As Long
Dim wsVList As Worksheet

Set wsVList = Worksheets("Vendors List")
wsVList.Cells.Clear

For Each cell In Range("A1:A116").Cells
If UCase(cell.Value) = "X" Then
wsVList.Range("A1").Offset(targetRow).Resize(, 7).Value =
cell.Offset(, 1).Resize(, 8).Value
targetRow = targetRow + 1
End If
Next
End Sub

 

[KC]

I guess that Jack has a "x" on a blank line to start with.

 

[Gord Dibben]

If you're still stuck after reading the other responses, send the workbook
to me at my email.

gorddibbATshawDOTca

Make the appropriate changes to AT and DOT


Gord

 

[Gord Dibben]

Sounds like a good guess.

Gord

I guess that Jack has a "x" on a blank line to start with.