VBA macro - Match to a single cell, copy multiple hits (with rows) and paste in first available row in a different sheet

[Engalpengal]

Hi all.
I am new to VBA programming but am in progress to learn how to use this wonderful tool.
Unfortunately, I cannot share the document due to its contents and that the information belongs to the company I work for. But I will try to explain what I am working on.

I have a long list of customer orders. Based on this list, I want to be able to extract a specific order. An order can have several product lines in the customer order list, but each product line refers to a given order no. Order no is shown in column B
Order list -> Sheets(«Customer order»).Range(«B24:M1000») - The product lines contain both numbers, dates and text, with and without formulas.

In another sheet in the same file, we enter a desired order number (this is entered manually in a given cell),
Order number -> Sheets("LA").Range("F6")
which retrieves all the product lines linked to the given order no for review.

When the person in question has reviewed the order, I want him or her to be able to, by pressing a button, copy (only value, text and numbers, not formatting or formulas) all order lines in the order list that match the order number in given cell -> Sheets("LA").Range("F6").

These order lines must now be pasted into a list for order history, first available row.

Order history -> Sheets("LA").Range("P:AA") - First row is P5:AA5
I have tried countless compositions I have found online but have not quite managed to adapt them to my needs.

The last one I have tried is the following:

Sub Ferdig_LASen()
Dim c As Range, wsSrc As Worksheet, wsOut As Worksheet, wb As Workbook
Dim cDest As Range, wsTrans As Worksheet, rngList As Range

Set wb = ThisWorkbook
Set wsSrc = wb.Worksheets("Kundeordre") 'orderlist, search area
Set wsOut = wb.Worksheets("LA") 'Paste area
Set wsTrans = wb.Worksheets("LA")
Set rngList = wsTrans.Range("F6") 'order no, search key
wsSrc.Rows(1).Copy wsOut.Rows(1)
Set cDest = wsOut.Range("P5:AA5") 'first paste destination

Application.ScreenUpdating = False
For Each c In wsSrc.Range("B24:B" & wsSrc.Cells(Rows.Count, "B").End(xlUp).Row).Cells
If Not IsError(Application.Match(c.Value, rngList, 0)) Then 'any match in lookup list?
c.EntireRow.Copy cDest
Set cDest = cDest.Offset(1) 'next paste row
End If
Next c
Application.ScreenUpdating = True
End Sub

There are probably many errors in this programming that I cannot see myself, so I need your expertise.
Hope my explanation and situation is understandable, and feel free to ask questions give feedback.
Thank you for your attention.
Look forward to your suggestions

 

[Engalpengal]

I forgot to mention that i know how to set up buttons with macro functions
Hope to hear from some of you soon

 

[Engalpengal]

Do any of you have a tip about a site where I can find the information I need to solve my macro problem?

 

[Alex Blakenburg]

In another sheet in the same file, we enter a desired order number (this is entered manually in a given cell),
Order number -> Sheets("LA").Range("F6")
which retrieves all the product lines linked to the given order no for review.

Do you have this part working ?
You have MS 365 so this part can be done but just putting a Filter function at F6.

 

[Engalpengal]

Thank you for your inquiry Alex
I get a Run time error '1004' on this part of the macro (marked in red):

Application.ScreenUpdating = False
For Each c In wsSrc.Range("B24:M" & wsSrc.Cells(Rows.Count, "B").End(xlUp).Row).Cells
If Not IsError(Application.Match(c.Value, rngList, 0)) Then 'any match in lookup list?
c.EntireRow.Copy cDest
Set cDest = cDest.Offset(1) 'next paste row
End If
Next c
Application.ScreenUpdating = True


The message is as follows (It is translated from another language, so it is conceivable that it may not be exactly the same message as in the English version):

"You cannot paste this here because the copy area and the paste area are not the same size
Just select a cell in the pasting area or an area of the same size and try pasting again"

I understand that there is a miss match between the area I have specified, but I still don't quite understand how to set/code it correctly.

 

[Alex Blakenburg]

You can't copy an Entire row to
Set cDest = wsOut.Range("P5:AA5") 'first paste destination

Try replacing you EntireRow copy line with this one:

            wsSrc.Range("B24:M" & c.Row).Copy cDest

PS: Your use of Match doesn't make sense. Like your comment says "any match in lookup list" but your rngList is not a list but a single cell
ie Set rngList = wsTrans.Range("F6")

 

[Engalpengal]

Thx Alex
I have done the changes you recommended, but perhaps i misunderstand you?
I still get the same Error
It may be that I am mixing up what is the search page and what is the paste page
When it comes to programming, it's hard to think backwards
Under follows updated macro

Sub Ferdig_LASen()

Dim c As Range, wsSrc As Worksheet, wsOut As Worksheet, wb As Workbook
Dim cDest As Range, wsTrans As Worksheet, rngList As Range

Set wb = ThisWorkbook
Set wsSrc = wb.Worksheets("Ordre") 'Sheet for search area
Set wsOut = wb.Worksheets("LA") 'Sheet for paste destination

Set wsTrans = wb.Worksheets("LA") 'Sheet search key
Set rngList = wsTrans.Range("F6") 'search key
wsSrc.Rows(1).Copy wsOut.Rows(1)
Set cDest = wsOut.Range("P:AA") 'Paste destination

Application.ScreenUpdating = False
For Each c In wsSrc.Range("B24:M" & wsSrc.Cells(Rows.Count, "B").End(xlUp).Row).Cells ' Area for search and copy from
If Not IsError(Application.Match(c.Value, rngList, 0)) Then 'any match in lookup list?
c.EntireRow.Copy cDest
Set cDest = cDest.Offset(1) 'next paste row
End If
Next c
Application.ScreenUpdating = True
End Sub

 

[Alex Blakenburg]

Give the below code a try:

PS: I have not changed this but since in
If Not IsError(Application.Match(c.Value, rngList, 0)) Then
rngList is a single cell (F6) you could just as easily have used
If UCase(c.Value) = UCase(rngList) Then

I suspect the Match line is not doing what you are meaning for it to do.

Sub Ferdig_LASen_v02_Mod01()

Dim c As Range, wsSrc As Worksheet, wsOut As Worksheet, wb As Workbook
Dim cDest As Range, wsTrans As Worksheet, rngList As Range

Set wb = ThisWorkbook
Set wsSrc = wb.Worksheets("Ordre") 'Sheet for search area
Set wsOut = wb.Worksheets("LA") 'Sheet for paste destination

Set wsTrans = wb.Worksheets("LA") 'Sheet search key
Set rngList = wsTrans.Range("F6") 'search key
wsSrc.Rows(1).Copy wsOut.Rows(1)
Set cDest = wsOut.Range("P5:AA5") 'Paste destination

Application.ScreenUpdating = False
For Each c In wsSrc.Range("B24:M" & wsSrc.Cells(Rows.Count, "B").End(xlUp).Row).Cells ' Area for search and copy from
    If Not IsError(Application.Match(c.Value, rngList, 0)) Then 'any match in lookup list?
        With wsSrc
            .Range(.Cells(c.Row, "B"), .Cells(c.Row, "M")).Copy cDest
        End With
        Set cDest = cDest.Offset(1) 'next paste row
    End If
Next c
Application.ScreenUpdating = True
End Sub

 

[Engalpengal]

Sorry for the very late response, it's been a lot at work.
Alex you are absolutely amazing!
I could kiss you ten times over!!!
Thank you so much, you have no idea how much this means to me.

 

[Engalpengal]

Just one question Alex.
If i wish to change the paste destination to another sheet. How would you write the command?

Set cDest = wsOut.Range("P5:AA5") 'Paste destination
New destination follows
Sheets("Ordre").Range("Z5:AK5") - first available row