Makro to find selected value in another sheet, copy rows under found value and paste below previously selected cell

[Marciboy]

Hello,

I need help with a makro in excel. I have got table1 in worksheet1 and on worksheet2 there is table2. Now, I want to select a certain value in table1, search for that value in table two and then copy the content below the found value and insert it under the selected value in table 1. Sometimes there is only one row that should be copied, then other times there are between 2 and 4 rows to be copied.

Table1
Sth.	Sth.	Sth.	Sth.	Value of interest	Sth.	etc.	etc	etc	etc
				Insert here	Insert here	Insert here	Insert here	Insert here	Insert here

Table2
nothing	nothing	nothing	nothing	Value of interest	nothing	nothing	nothing	nothing	nothing
nothing	nothing	nothing	nothing	Value to copy over	Value to copy over	Value to copy over	Value to copy over	Value to copy over	Value to copy over
nothing	nothing	nothing	nothing	Value to copy over	Value to copy over	Value to copy over	Value to copy over	Value to copy over	Value to copy over
nothing	nothing	nothing	nothing	Value to copy over	Value to copy over	Value to copy over	Value to copy over	Value to copy over	Value to copy over
nothing	nothing	nothing	nothing	nothing	nothing	nothing	nothing	nothing	nothing
				Value that could be of interest	nothing	nothing	nothing	nothing	nothing
				Value that could be to copy	etc.	etc.	...	...	...

 

[Marciboy]

I have the following but i have troubles with pasting the copied data into the saved cell address from the beginning

Sub copy_row()

Dim search As String
Dim pastle As Worksheet
Dim a As String

a = ActiveCell.Address


Set pastle = ActiveSheet
search = ActiveCell.Value

Sheets("Kalkulation").Select
Range("A26:A60").Select
    
    Selection.Find(What:=search, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        
    ActiveCell.Offset(1, 0).Select

If ActiveCell.Value = "ME406072" Or ActiveCell.Value = "ME530513" Then

    ActiveCell.Resize(1, 6).Select
    Range(Selection, Selection.End(xlDown)).copy

Else

    ActiveCell.Resize(1, 6).copy
    
    With pastle
        .Range("a").PasteSpecial paste:=xlPasteValues
    End With
    
End If

End Sub