Copy rows to another Sheet position

[S42k20]

Hello

I am wondering how this can be done:
I want to copy a specific rows from Sheet A into a specific row-position in Sheet B with variables.

I think the idea is simple but I can't solve it:

I am looking in Sheet B for values > 0 through a column ,top down.
If there is a value (e.g. = 4), take this value and copy all rows out of Sheet A with this value in column A under the position where the value = 4 was found in Sheet B ...

Could anybody help here? Thank you really much for helping!!
Best regards

 

[cooper645]

How about this:

Option Explicit

Sub ImportRows()
'https://www.mrexcel.com/board/threads/copy-rows-to-another-sheet-position.1146273/
Dim shtA As Worksheet, shtB As Worksheet
Dim RngA As Range, RngB As Range, d As Range
Dim LRowA As Long, LRowB As Long
Dim i As Double, j As Double

On Error GoTo EH

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

LRowA = Sheets("SheetA").Cells(Rows.Count, "A").End(xlUp).Row
LRowB = Sheets("SheetB").Cells(Rows.Count, "A").End(xlUp).Row
Set shtA = Sheets("SheetA") 'Amend for your Sheet to extract FROM
Set shtB = Sheets("SheetB") 'Amend for your Sheet to extract TO

'The 1 in the loop below assumes checking in column A, B would be 2, C 3 and so on
For i = LRowB To 1 Step -1
    For j = 1 To LRowA
        If shtA.Cells(j, 1).Value > 0 And shtA.Cells(j, 1).Value = shtB.Cells(i, 1).Value Then
            shtB.Range(i + 1 & ":" & i + 1).Insert Shift:=xlDown
                shtA.Range("A" & j & ":B" & j).Copy shtB.Range("A" & i + 1 & ":B" & i + 1) 'Amend range B column to suit your data set
        End If
    Next j
Next i

EH:
With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

End Sub