VBA Copy Paste Value Based on Value

[luke1438]

I would like to copy the data from sheet 1 based on the Item Number in cell B5 and paste value it to Sheet 2 at the correct item number. Just copy and paste columns "C" through "H". I have tried the Macro recorder and cannot get it to do what I need. Any suggestions would be greatly appreciated. Thank you! See image below:

Book2
	B	C	D	E	F	G	H
4	SHEET 1	C	D	E	F	G	H
5	3314
6	Item	Check				Amount
7	Number	Number	Date		Transaction Description	Debit	Credit
8	3311	2267	12/29/2008		Lotus Underground	1,526.10
9	3312	2268	12/31/2008		168 Market	236.45
10	3313	2269	12/31/2008		Avis Concrete	6,625.89
11	3314	2270	1/25/2009		TEST 1	5.03
12	3315	2271	2/7/2009		TEST 2	25.00
13	3316	2272	3/1/2009		TEST 3	35.00
14	3317	2273	3/5/2009		TEST 4	-	55.00
15
16
17	SHEET 2	C	D	E	F	G	H
18	item	Check				Amount
19	Number	Number	Date		Transaction Description	Debit	Credit
20	3309	2265	12/27/2008		Q Board Lumber Supply	1,536.22
21	3310	2266	12/28/2008		Anderson Windows	4,516.30
22	3311	2267	12/29/2008		Lotus Underground	1,526.10
23	3312	2267	12/31/2008		168 Market	236.45
24	3313	2269	12/31/2008		Avis Concrete	6,625.89
25	3314
26	3315
27	3316
28	3317
29	3318
30
Sheet1

 

[Tom Urtis]

This should do what you want, based on your screen shots.

Sub test()
Dim myFind1 As Variant, myFind2 As Variant, strFind$, myFindRow1&, myFindRow2&
strFind = Range("B5").Value
 
Set myFind1 = Range("B8:B" & Cells(Rows.count, 2).End(xlUp).Row).Find(What:=strFind, LookIn:=xlFormulas, LookAt:=xlWhole)
If myFind1 Is Nothing Then
MsgBox strFind & " was not found in column A on Sheeet1.", 48, "No such animal."
Exit Sub
End If
 
Set myFind2 = Sheets("Sheet2").Columns(2).Find(What:=strFind, LookIn:=xlFormulas, LookAt:=xlWhole)
If myFind2 Is Nothing Then
MsgBox strFind & " was not found in column A on Sheeet2.", 48, "No such animal."
Exit Sub
End If
 
myFindRow1 = myFind1.Row: myFindRow2 = myFind2.Row
Range(Cells(myFindRow1, 3), Cells(myFindRow1, 8)).Copy Sheets("Sheet2").Cells(myFindRow2, 3)
End Sub

 

[luke1438]

Tom, Thanks. I did some minor tweeking and it works in my workboook. However, I screwed up. It was a little too late last night when I wrote the post; I knew what I wanted, I just didn't communicate it. I am sorry. What I am really trying to do is copy 5,000 rows down and then paste it in Sheet 2 without the formating; Sheet 1 from cell B8 to H5000. I have looked in my Bill Jelen book, but the code you are using does not seem to be covered in his book. So, I am unsure how to have it copy that range. I tried adding a second range variable but I got all kinds of errors. I am trying to learn this stuff so if you change something please tell me why you are doing it that way.

Thanks
Luke

Sub test()
Dim myFind1 As Variant, myFind2 As Variant, strFind$, myFindRow1&, myFindRow2&
strFind = Range("B4").Value
 
Set myFind1 = Range("B4:B" & Cells(Rows.Count, 2).End(xlUp).Row).Find(What:=strFind, LookIn:=xlFormulas, LookAt:=xlWhole)
If myFind1 Is Nothing Then
MsgBox strFind & " was not found in column B on Sheet 1.", 48, "No such animal."
Exit Sub
End If
 
Set myFind2 = Sheets("Sheet2").Columns(2).Find(What:=strFind, LookIn:=xlFormulas, LookAt:=xlWhole)
If myFind2 Is Nothing Then
MsgBox strFind & " was not found in column B on Sheet 2.", 48, "No such animal."
Exit Sub
End If
 
myFindRow1 = myFind1.Row: myFindRow2 = myFind2.Row
Range(Cells(myFindRow1, 3), Cells(myFindRow1, 8)).Copy Sheets("Sheet2").Cells(myFindRow2, 3)
End Sub

 

[Tom Urtis]

OK, see if I have some of the components understood...

So in every case no matter what, you want to copy range B8:H5000 from Sheet1

and

you want to copy that range and paste special for values to Sheet2

and

the destination range in Sheet2 will be...this is where I am stuck, how do you know where to send the copied values to. It does not make sense that the Item Numbers in column B of Sheet1 will be copied over, next to, or below Item Numbers in column B of Sheet2 when you are using a criterion for some reason in cell B5 of Sheet1 which you should also please re-explain.

I'm lost on what you are doing and why, especially, where the copied values should go to and why.

 

[luke1438]

Ok, here's the whole thing step by step. I am writing it as if I were doing it manually.

(I copied and pasted just a few rows from each sheet and put them on one sheet for easier illustration, that is in my original post.)

1) The number 3314 in Sheet 1 cell B5 highlighted in yellow is the number I am trying to find in column B, Sheet 1.
2) Then I need to copy that row (and 5,000 rows down) columns C through H in Sheet 1.
3) Then I need to find 3314 in column B Sheet 2 and paste without formating the data from Sheet 1 columns C through H and 5,000 rows down.

It is working great in that it copies and pastes the correct row from Sheet 1 into the correct place on Sheet 2. However, I just need it to go further and copy not only the row that corresponds to the 3314 but also the next 5,000 rows down. Then paste those 5,000 rows without formating in Sheet 2.

I am sorry for all the confusion. I should not have posted the code that I altered, it makes it more confusing because I changed some of the columns and rows to fit my worksheets. In my original post I put everything on one sheet to make it easier to see and the columns and rows are slightly off.

Thank you for all your help.
Luke

 

[Tom Urtis]

Is this what you want?

Sub test2()
Dim myFind1 As Variant, myFind2 As Variant, strFind$, myFindRow1&, myFindRow2&
strFind = Range("B5").Value
 
Set myFind1 = Range("B8:B" & Cells(Rows.Count, 2).End(xlUp).Row).Find(What:=strFind, LookIn:=xlFormulas, LookAt:=xlWhole)
If myFind1 Is Nothing Then
MsgBox strFind & " was not found in column A on Sheeet1.", 48, "No such animal."
Exit Sub
End If
 
Set myFind2 = Sheets("Sheet2").Columns(2).Find(What:=strFind, LookIn:=xlFormulas, LookAt:=xlWhole)
If myFind2 Is Nothing Then
MsgBox strFind & " was not found in column A on Sheeet2.", 48, "No such animal."
Exit Sub
End If
With Application
.ScreenUpdating = False
myFindRow1 = myFind1.Row: myFindRow2 = myFind2.Row
Range(Cells(myFindRow1, 3), Cells(5000, 8)).Copy
Sheets("Sheet2").Cells(myFindRow2, 3).PasteSpecial Paste:=xlPasteValues
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub

 

[luke1438]

Tom,

Thank you very much, works perfect. If you don't mind; how did you know to use "with"? The book I have really does not talk about "with". Is there a publication you would recomend to learn more than the basics?

Thank you for all your help.
Luke

 

[Tom Urtis]

No book covers everything so I would recommend browsing through the ones you see at your local bookstores to get a feel for the books' content and overall intuitive-to-you presentation.

Generally if I have more than 2 objects or properties being worked on, I stick them in a With structure, so in this case for Application...

With Application
.ScreenUpdating = False
myFindRow1 = myFind1.Row: myFindRow2 = myFind2.Row
Range(Cells(myFindRow1, 3), Cells(5000, 8)).Copy
Sheets("Sheet2").Cells(myFindRow2, 3).PasteSpecial Paste:=xlPasteValues
.CutCopyMode = False
.ScreenUpdating = True
End With

could have been...

Application.ScreenUpdating = False
myFindRow1 = myFind1.Row: myFindRow2 = myFind2.Row
Range(Cells(myFindRow1, 3), Cells(5000, 8)).Copy
Sheets("Sheet2").Cells(myFindRow2, 3).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True

...which looks like an opportunity (because I see 3 of them, but that's me) to make the code easier to read and write by only qualifying the Application parent once instead of 3 times.