Copy list of cells to another sheet

[123excel]

Hi, I am using the below code to copy cells from a list in the active sheet if they contains the same value as "K1".

I then call another macro (Sheet_Select) to select the sheet that is named the same as "K1".

When the sheet is selected I am pasting the copied cell to "A36".

This works but what I need to change is this:

1. Right now, only one cell in one row is copied (-2 offset from one cell that contains the value of "K1"). I need the cells in all rows that contains the "K1" value in column C to be copied. I also need the range of -2 and -1 offset cell to be copied, not just the cell -2 as it is now.

Now is the code:
If Cells(R, Col).Value = Range("K1").Value ThenCells(R, Col).Offset(0, -2).Copy

2. I also need to paste all of the values in the new selected sheet for "A36:B36" and downwards.

Now is the code:
Range("A36").Select
ActiveSheet.Paste


How can I achieve this?

Sub Sheet_to_sheet()


    Dim Col As Variant
    Dim BlankRows As Long
    Dim LastRow As Long
    Dim R As Long
    Dim StartRow As Long


        Col = "C"
        StartRow = 33
        BlankRows = 1


            LastRow = Cells(Rows.Count, Col).End(xlUp).Row


            Application.ScreenUpdating = False


            With ActiveSheet
For R = LastRow To StartRow + 1 Step -1


If Cells(R, Col).Value = Range("K1").Value Then
Cells(R, Col).Offset(0, -2).Copy


Call Sheet_Select


Range("A36").Select
    ActiveSheet.Paste


End If
Next R
End With
Application.ScreenUpdating = True


End Sub

 

[DanteAmor]

Try this

Sub Sheet_to_sheet()
    Dim sh As Worksheet, sh2 As Worksheet, col As String
    Dim lr As Long, i As Long, j As Long
    
    Application.ScreenUpdating = False
    
    Set sh = ActiveSheet
    Set sh2 = Sheets(sh.Range("K1").Value)
    col = "C"
    StartRow = 33
    lr = sh.Cells(Rows.Count, col).End(xlUp).Row
    j = 36
    
    For i = lr To StartRow + 1 Step -1
        If sh.Cells(i, col).Value = sh.Range("K1").Value Then
            sh2.Range("A" & j & ":B" & j).Value = sh.Range("A" & i & ":B" & i).Value
            j = j + 1
        End If
    Next
End Sub

 

[123excel]

It works great!

Just one thing, It now overwrites the data thats already been pasted. How can paste it in the first empty cell After row A36:B36?

 

[DanteAmor]

Change this line:

j = 36

By:

j = [COLOR=#333333]sh2.Cells(Rows.Count, "A").End(xlUp).Row + 1[/COLOR]

 

[123excel]

It works perfect! Thank you so much for helping out with your knowledge. This will hopefully also help someone else and I really appreciate it!

 

[DanteAmor]

It works perfect! Thank you so much for helping out with your knowledge. This will hopefully also help someone else and I really appreciate it!

I'm glad to help you. I appreciate your kind comments.