VBA- Transfer data from one sheet to another based on text and placing in into a specific location in the other sheet

Question

This would be the data, I would like to be able to take all the PP from sheet4 and paste them into sheet PDH_Handvoer in a specific range say A11:A22. Then also take the FA and paste them into the same sheet but with range A30:A42 and so one for each of the letters.

so far this is the code, but it isnt doing what I need it to

Private Sub CommandButton1_Click()


Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet4")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("PDH_Handover")

Dim LRow1 As Long, LRow2 As Long, i As Long
LRow1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row

For i = 2 To LRow1
    If ws1.Cells(i, 1) = "pp" Then
        ws1.Range(Cells(i, 2), Cells(i, 5)).Copy
        ws2.Range("A" & LRow2 + 1).PasteSpecial xlPasteValues
    End If
Next
End Sub 

Answer 1

Your code is working, you just need to re-grab the LRow2 value after you paste a new line - otherwise you're always overwriting your first line (and in you case, your last copied line is blank, so it looks like nothing is happening when it actually is).

I've also added Application.CutCopyMode = False to the end, as good practice (that clears the clipboard).

Private Sub CommandButton1_Click()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet4")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("PDH_Handover")

Dim LRow1 As Long, LRow2 As Long, i As Long
LRow1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row

For i = 2 To LRow1
    If ws1.Cells(i, 1) = "PP" Then
        ws1.Range(Cells(i, 2), Cells(i, 5)).Copy
        ws2.Range("A" & LRow2 + 1).PasteSpecial xlPasteValues

        'Get new last row value
        LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
    End If
Next

Application.CutCopyMode = False

End Sub

Rather, let's just get rid of Copy/Paste altogether, as it's best to avoid syntax that relies on ActiveSheet :

Private Sub CommandButton1_Click()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet4")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("PDH_Handover")

Dim LRow1 As Long, LRow2 As Long, i As Long
LRow1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row

For i = 2 To LRow1
    If ws1.Cells(i, 1) = "PP" Then
        ws2.Range(ws2.Cells(LRow2 + 1, 1), ws2.Cells(LRow2 + 1, 4)).Value = _
        ws1.Range(ws1.Cells(i, 2), ws1.Cells(i, 5)).Value

        'Get new last row value
        LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
    End If
Next

End Sub

Answer 2

If we get the right value of LRow2 in the first time, I prefer to LRow2 = LRow2 + 1 but not to End(xlUp).row

Private Sub CommandButton1_Click()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim LRow1 As Long, LRow2 As Long, i As Long

Set ws1 = Application.ThisWorkbook.Sheets("Sheet4")
Set ws2 = Application.ThisWorkbook.Sheets("PDH_Handover")
LRow1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).row
LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).row

For i = 2 To LRow1
    If ws1.Cells(i, 1) = "PP" Then
        ws1.Range(Cells(i, 2), Cells(i, 5)).Copy
        ws2.Range("A" & LRow2 + 1).PasteSpecial xlPasteValues

        'Get new last row value
        LRow2 = LRow2 + 1
    End If
Next

End Sub