If criteria met copy certain cells to another worksheet

[englandmark]

Still trying to get my head round VBA, would appreciate the help hear

If
Worksheet Call Log, cell F has Mitch entered
Copy and paste to next blank row Worksheet Bid Log,
Cell C = Worksheet Call Log cell D
Cell D = Worksheet Call Log cell E
Cell E = Worksheet Call Log cell F
Cell F = Worksheet Call Log cell H
Cell G = Worksheet Call Log cell J
Cell K = Worksheet Call Log cell K
Cell L = Worksheet Call Log cell M
Cell M = Worksheet Call Log cell N
Then
end

 

[The_Macrotect]

Re: Need help if criteria met copy certain cells to another worksheet

Hi there - where exactly will "Mitch" be entered? Which row in column F? Or does the code need to look in every row?

 

[englandmark]

Re: Need help if criteria met copy certain cells to another worksheet

worksheet Call Log Rows will add with information and Mitch may be selected in Column F
when Mitch is selected i need it to copy and paste column cells (as above) to worksheet Bid Log next blank row to column cells (as above)
Thanks in advance for the help
Mark

 

[The_Macrotect]

Re: Need help if criteria met copy certain cells to another worksheet

Does the macro need to search every row in your "Call Log" sheet to see if the word "Mitch" is in Column F?

 

[englandmark]

Re: Need help if criteria met copy certain cells to another worksheet

Yes

 

[englandmark]

Re: Need help if criteria met copy certain cells to another worksheet

Thanks for the help, is there any other information you need?

 

[The_Macrotect]

Re: Need help if criteria met copy certain cells to another worksheet

Try this on a copy of your work. It will work as long as each used row on the "Bid Log" sheet has a value in column C. Let me know if this does the trick.

Sub Find_Value_and_Copy()
Dim lastrow_call As Integer, lastrow_bid As Integer, x As Integer, y As Integer, z As Integer

lastrow_call = Sheets("Call Log").UsedRange.Rows.Count
lastrow_bid = Sheets("Bid Log").UsedRange.Rows.Count

For x = 1 To lastrow_bid
y = WorksheetFunction.CountA(Sheets("Bid Log").Range("A" & x & ":M" & x))
If y = 0 Then GoTo Search
Next x

Search:

For z = 1 To lastrow_call
If Sheets("Call Log").Cells(z, 6) = "Mitch" Then
Sheets("Call Log").Cells(z, 4).Copy Sheets("Bid Log").Cells(x, 3)
Sheets("Call Log").Cells(z, 5).Copy Sheets("Bid Log").Cells(x, 4)
Sheets("Call Log").Cells(z, 6).Copy Sheets("Bid Log").Cells(x, 5)
Sheets("Call Log").Cells(z, 8).Copy Sheets("Bid Log").Cells(x, 6)
Sheets("Call Log").Cells(z, 10).Copy Sheets("Bid Log").Cells(x, 7)
Sheets("Call Log").Cells(z, 11).Copy Sheets("Bid Log").Cells(x, 11)
Sheets("Call Log").Cells(z, 13).Copy Sheets("Bid Log").Cells(x, 12)
Sheets("Call Log").Cells(z, 14).Copy Sheets("Bid Log").Cells(x, 13)
End If
Next z

End Sub

 

[The_Macrotect]

Re: Need help if criteria met copy certain cells to another worksheet

Oops, I caught a mistake. Use this instead:

Sub Find_Value_and_Copy()
Dim lastrow_call As Integer, lastrow_bid As Integer, x As Integer, y As Integer, z As Integer

lastrow_call = Sheets("Call Log").UsedRange.Rows.Count
lastrow_bid = Sheets("Bid Log").UsedRange.Rows.Count

For x = 1 To lastrow_bid
y = WorksheetFunction.CountA(Sheets("Bid Log").Range("A" & x & ":M" & x))
If y = 0 Then GoTo Search
Next x

Search:

For z = 1 To lastrow_call
If Sheets("Call Log").Cells(z, 6) = "Mitch" Then
Sheets("Call Log").Cells(z, 4).Copy Sheets("Bid Log").Cells(x, 3)
Sheets("Call Log").Cells(z, 5).Copy Sheets("Bid Log").Cells(x, 4)
Sheets("Call Log").Cells(z, 6).Copy Sheets("Bid Log").Cells(x, 5)
Sheets("Call Log").Cells(z, 8).Copy Sheets("Bid Log").Cells(x, 6)
Sheets("Call Log").Cells(z, 10).Copy Sheets("Bid Log").Cells(x, 7)
Sheets("Call Log").Cells(z, 11).Copy Sheets("Bid Log").Cells(x, 11)
Sheets("Call Log").Cells(z, 13).Copy Sheets("Bid Log").Cells(x, 12)
Sheets("Call Log").Cells(z, 14).Copy Sheets("Bid Log").Cells(x, 13)
x = x + 1
End If
Next z

End Sub

 

[englandmark]

Re: Need help if criteria met copy certain cells to another worksheet

https://www.dropbox.com/s/8m66ya856tndb97/RPI Roofing call log 2019.xlsm?dl=0

File is located here
Call log entries are entered daily and if Mitch is selected transfer data to bid log, code has been entered with correct reference of columns but not working
Thanks in advance for the help

 

[englandmark]

Re: Need help if criteria met copy certain cells to another worksheet

This is the code but its not working it returns an error

run time error '1004':
copy method of range class failed



Sub Find_Value_and_Copy()
Dim lastrow_call As Integer, lastrow_bid As Integer, x As Integer, y As Integer, z As Integer


lastrow_call = Sheets("Call Log").UsedRange.Rows.Count
lastrow_bid = Sheets("Bid Log").UsedRange.Rows.Count


For x = 1 To lastrow_bid
y = WorksheetFunction.CountA(Sheets("Bid Log").Range("A" & x & ":Q" & x))
If y = 0 Then GoTo Search
Next x


Search:


For z = 1 To lastrow_call
If Sheets("Call Log").Cells(z, 12) = "Mitch" Then
Sheets("Call Log").Cells(z, 4).Copy Sheets("Bid Log").Cells(x, 3)
Sheets("Call Log").Cells(z, 6).Copy Sheets("Bid Log").Cells(x, 5)
Sheets("Call Log").Cells(z, 5).Copy Sheets("Bid Log").Cells(x, 4)
Sheets("Call Log").Cells(z, 7).Copy Sheets("Bid Log").Cells(x, 6)
Sheets("Call Log").Cells(z, 8).Copy Sheets("Bid Log").Cells(x, 7)
Sheets("Call Log").Cells(z, 9).Copy Sheets("Bid Log").Cells(x, 8)
Sheets("Call Log").Cells(z, 11).Copy Sheets("Bid Log").Cells(x, 10)
Sheets("Call Log").Cells(z, 1).Copy Sheets("Bid Log").Cells(x, 2)
x = x + 1
End If
Next z


End Sub