Search copy paste from one sheet to another using only selected cells

[kevinchurchill]

Hello,


I have an inventory XL spread sheet, what I would like to do is search for a specific refference N°(code article SAP) that will be in column B sheet 1 and then copying only the data for that refference that is in rows, N,O,P,R. and then pasting that data to another sheet, i want this as the end user does not need to see the full data relevent to the refference N°.
So the first example below is what I want to end up with on another sheet after searching the first sheet using only the Code article SAP N°.
I hope this is clear.
Many thanks for your help

	N N	O	P	R
	Code article SAP	Numéro de commande	Date d'envoi de la commande	Délais de livraison prévu
	700013205	4500456266	12/01/2018	18/01/2018

<colgroup><col width="80" style="width: 60pt;" span="5"> <tbody> </tbody>

Date de la DDM	date de demande chiffrage	Retour chiffrage	Date d'envoi de la commande	Numéro de commande	Code article SAP	Montant	Délais de livraison prévu	Date Reception
01/01/2018	11/01/2018	11/01/2018	17/01/2018	9500303528		540,00 €	24/01/2018	24/01/2018
01/01/2018	01/01/2018	01/01/2018	16/01/2018	9500303432		224,00 €	23/01/2018	24/01/2018
01/01/2018	01/01/2018	01/01/2018	04/01/2018	9500303079		74,00 €	10/01/2018	12/01/2018
01/01/2018	01/01/2018	01/01/2018	24/01/2018	4500457298		6 729,17 €	06/02/2018	13/02/2018
01/01/2018	08/01/2018	08/01/2018	12/01/2018	4500456266	700013205	95,00 €	18/01/2018	16/01/2018
01/01/2018	01/01/2018	05/01/2018	05/01/2018	4500455815	700013746	761,52 €	18/01/2018	22/01/2018
03/01/2018	03/01/2018	12/01/2018	17/01/2018	9500303528		253,96 €	24/01/2018	24/01/2018
03/01/2018	03/01/2018	03/01/2018	04/01/2018	9500303079		1 065,44 €	25/01/2018	12/01/2018
03/01/2018	03/01/2018	03/01/2018	03/01/2018	9500303052		365,35 €	03/01/2018	03/01/2018

<colgroup><col width="111" style="width: 83pt; mso-width-source: userset; mso-width-alt: 4059;"> <col width="116" style="width: 87pt; mso-width-source: userset; mso-width-alt: 4242;"> <col width="127" style="width: 95pt; mso-width-source: userset; mso-width-alt: 4644;"> <col width="136" style="width: 102pt; mso-width-source: userset; mso-width-alt: 4973;"> <col width="145" style="width: 109pt; mso-width-source: userset; mso-width-alt: 5302;" span="5"> <tbody> </tbody>

 

[vcoolio]

Hello Kevin,

If you have tested the sample in the link from post #8 you will see that only the relevant cells per row of data are transferred over. For example, in the sample file, if you type in SAP number 10005 and click on the "GO" button, only the relevant cells from two rows related to that SAP number are transferred over not the whole column.
If you have tested the code in your actual workbook and you have this issue then there must be something else at play. You may have to upload a sample of your actual workbook for us to work with. You can upload a sample to a free file sharing site such as Drop Box or ge.tt then post the link to your file back here.
Make sure that the sample is an exact replica of your workbook but please use dummy data.

Cheerio,
vcoolio.

 

[kevinchurchill]

Hello Vcoolio,
I have now successfully intergrated your code into my worksheet and with a few tweeks for the final position for the search results it is now working perfect.
I would if I may ask you one more favour as I have tried many things but not succeeded, and that is to have a message box displayed if the SAP number is not found i.e "code article non trouvé".
I can make this box appear when there is no such code found but it also appears when a correct code is found.
One again, many thanks.
Kevin.

 

[vcoolio]

Hello Kevin,

Test the following modified code in the sample file in post #8. It will do as you require.

Sub TransferData()

        Dim SAPSrch As String
        Dim lr As Long, [COLOR=#ff0000]sRng As Range[/COLOR]
        Dim cArr As Variant, pArr As Variant

SAPSrch = Sheet2.[A1].Value
lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
cArr = Array("N2:N" & lr, "O2:O" & lr, "P2:P" & lr, "R2:R" & lr)
pArr = Array("N", "O", "P", "R")

Application.ScreenUpdating = False

[COLOR=#ff0000]With Sheet1.Range("P:P")[/COLOR]
        [COLOR=#ff0000]Set sRng = .Find(What:=SAPSrch, After:=.Cells(.Cells.Count), lookat:=xlWhole)
        If Not sRng Is Nothing Then[/COLOR]
Sheet1.[A1].CurrentRegion.AutoFilter 16, SAPSrch
        For x = LBound(cArr) To UBound(cArr)
        Sheet1.Range(cArr(x)).Copy
        Sheet2.Range(pArr(x) & Rows.Count).End(3)(2).PasteSpecial xlValues
        Next x
[COLOR=#ff0000]    Else
        MsgBox "Code article non trouvé."
        End If
End With[/COLOR]

Sheet1.[P1].AutoFilter
Sheet2.[A1].Value = "SAP Search"

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

The lines in red font are the additional lines which should do the task for you.

I hope that this helps.

Cheerio,
vcoolio.

 

[kevinchurchill]

Hello Vcoolio,
Thanks for the code, On you're test workbook it works fine, when I have transferred it to my workbook and typed a wrong code in the search box all is good, I have the message box as it should be displayed, however when I OK the message box it dissapeares like it should and then when I type a code that is in the P column, I recieve a runtime error 1004 on the line with red text, and the programme is blocked, I have pasted a copy of the code below, you can see that my search box and results columns are not in the same place as on your workbook.


Sub TransferData()
Dim SAPSrch As String
Dim lr As Long, sRng As Range
Dim cArr As Variant, pArr As Variant
SAPSrch = Feuil1.[H4].Value
lr = Feuil2.Range("A" & Rows.Count).End(xlUp).Row
cArr = Array("N5:N" & lr, "O5:O" & lr, "P5:P" & lr, "R5:R" & lr)
pArr = Array("C", "D", "E", "F")
Application.ScreenUpdating = False
With Feuil2.Range("P:P")
Set sRng = .Find(What:=SAPSrch, After:=.Cells(.Cells.Count), lookat:=xlWhole)
If Not sRng Is Nothing Then

Feuil2.[P5].CurrentRegion.AutoFilter 16, SAPSrch
For x = LBound(cArr) To UBound(cArr)
Feuil2.Range(cArr(x)).Copy
Feuil1.Range(pArr(x) & Rows.Count).End(3)(1).PasteSpecial xlValues
Next x
Else
MsgBox "Code article non trouvé."
End If
End With


Feuil2.[P1].AutoFilter
Feuil1.[H4].Value = "7000"

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

When the message box code is removed it works ok like before.
Best regards, Kevin.

 

[vcoolio]

Hello Kevin,

Can you please upload a sample of your workbook to a free file sharing site such as ge.tt or Drop Box then post the link to your file back here. This will give me something more to work with.
Make sure that the sample is an exact replica of your workbook and please use dummy data. Just a few rows of data per sheet will do.

Cheerio,
vcoolio.

 

[kevinchurchill]

Hello Vcoolio,

Here is the link of the exact workbook with minimal data left but enough for you to see what is happening.
https://www.dropbox.com/s/e4p39sybabyu2dl/Suivi commande 2018 Alertre rupture.xlsm?dl=0

Thanks for your patience.
Kevin

 

[vcoolio]

Hello Kevin,

I had to transpose your workbook sample to a blank Excel file as the sample you supplied came up with the error "Can't find project or library".

But anyway, following is the code again. You'll notice some subtle adjustments to suit your workbook:-

Sub TransferData2()

        Dim SAPSrch As String
        Dim lr As Long, sRng As Range
        Dim cArr As Variant, pArr As Variant
        SAPSrch = Sheet1.[H4].Value
        lr = Sheet2.Range([COLOR=#ff0000]"O"[/COLOR] & Rows.Count).End(xlUp).Row
[COLOR=#ff0000]
cArr = Array("N6:N" & lr, "O6:O" & lr, "P6:P" & lr, "R6:R" & lr)[/COLOR]
pArr = Array("C", "D", "E", "F")

Application.ScreenUpdating = False

With Sheet2.Range("P:P")
        Set sRng = .Find(What:=SAPSrch, After:=.Cells(.Cells.Count), lookat:=xlWhole)
If Not sRng Is Nothing Then
Sheet2.[COLOR=#ff0000][A5][/COLOR].CurrentRegion.AutoFilter 16, SAPSrch
        For x = LBound(cArr) To UBound(cArr)
        Sheet2.Range(cArr(x)).Copy
        Sheet1.Range(pArr(x) & Rows.Count).End(3)[COLOR=#ff0000](2)[/COLOR].PasteSpecial xlValues
        Next x
Else
MsgBox "Code article non trouvé."
End If
End With


Sheet2.[COLOR=#ff0000][P5][/COLOR].AutoFilter
Sheet1.[H4].Value = "7000"

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

The changes are noted in red font in the above code.
The Runtime Error that you received is due to the fact that the CurrentRegion starts at A5 not P5 as in your code in post #14 .

You may notice that I've had to use the English sheet codes (Sheet1, Sheet2 etc.). You'll just need to change them back to the French sheet codes (Feuil1 etc.).

I hope that this helps.

Cheerio,
vcoolio.

 

[kevinchurchill]

Hello Vcoolio,
What can I say, you're a Genius, evrything now works perfectly as I had first envisaged, the workbook is now live and with you're coding life will be more easy to search for items and give alerts when needed, much appreciated that you have given you're time to help a complete stranger.
Thank you.
Kevin.

 

[vcoolio]

Hello Kevin,

Thank you for the kind words and you're welcome. I'm glad that I was able to help you.

Cheerio,
vcoolio.