Merge multiple sheets into single sheet

I'm totally new to VBA, so forgive any errors. Someone very kindly submitted the following piece of code for me. Problem is I can't get it to do more than a single row. Ie. it will correctly input data from row 2 of each of my 4 worksheets but then won't merge any other rows.

I am trying to merge data from 4 worksheets. Each worksheet uses an ID column but each ID doesn't appear in each sheet. Each sheet contains different characteristic data for each item (row).

Um, if anyone can help with the code I'd be really, really grateful. :-)

Option Explicit

Sub CreateMasterSht()

Dim LRow1, LRow2, LRow3, i As Integer
Dim sID As String
Dim rCell As Range

Application.ScreenUpdating = False

LRow1 = Worksheets("Sheet1").Cells(Cells.Rows.Count, 1).End(xlUp).Row
LRow2 = Worksheets("Sheet2").Cells(Cells.Rows.Count, 1).End(xlUp).Row
LRow3 = 2
                                                                'Copy data for each unique ID
For i = 2 To LRow3
    sID = Worksheets("Sheet5").Cells(i, 1)
    With Worksheets("Sheet1")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Resize(, 2).Copy
            Worksheets("Sheet5").Cells(i, 2).PasteSpecial xlPasteAll
        End If
    End With
    With Worksheets("Sheet2")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Resize(, 1).Copy
            Worksheets("Sheet5").Cells(i, 4).PasteSpecial xlPasteAll
        End If
    End With
    With Worksheets("Sheet3")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Resize(, 7).Copy
            Worksheets("Sheet5").Cells(i, 5).PasteSpecial xlPasteAll
        End If
    End With
    With Worksheets("Sheet4")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Resize(, 127).Copy
            Worksheets("Sheet5").Cells(i, 12).PasteSpecial xlPasteAll
        End If
    End With
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub