How do you run a VBA loop to format each worksheet, and create a summary tab

I have a spreadsheet with 20+ worksheets listing servers. I am trying to format each sheet to pull only the first four columns of data, while preserving the original data. I am inserting 6 columns on the left, creating column headings, copying the first four rows of data (with starting name of "SERV-"), then putting the name of the worksheet in the 5th column. I got the code to work fine if ran in one sheet. I am trying to put it in a loop, but it isn't working. It is inserting the columns and headers in the first worksheet only.

Once I have this loop working, I want to create a summary tab where it pulls the data from these first five rows of each sheet into the summary tab. This should be easy, but I haven't gotten to that point in the code yet.

This is the code I have so far:

'PhaseOne of test code

Sub PhaseOne()
Dim ws As Worksheet
 Dim lngRow As Long
 Dim lngCount As Long
 lngRow = 8

 For Each ws In Worksheets


    '(2) Remove blank rows (WORKS)
        Dim x As Long
        With ws
            For x = .Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
                If WorksheetFunction.CountA(.Rows(x)) = 0 Then
                ws.Rows(x).Delete
                End If
            Next
        End With

    '(3) Insert 5 columns (WORKS)
        Columns("A:F").Insert Shift:=xlToRight

    '(4) Label columns (WORKS)
        Range("$A$1").Value = "ServLabel"
        Range("$B$1").Value = "Primary IP"
        Range("$C$1").Value = "DC"
        Range("$D$1").Value = "Service ID"
        Range("$E$1").Value = "Sheet"'(5) Find and Copy Range (WORKS)
        Dim lastRow As Long
        With ws
            lastRow = .Cells(.Rows.Count, "J").End(xlUp).Row
        End With
        Dim rFound As Range
        On Error Resume Next
        Set rFound = Cells.Find(What:="SERV-", _
                    After:=Cells(Rows.Count, Columns.Count), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
        On Error GoTo 0
        If rFound Is Nothing Then
        Else
            rFound.Select
            Selection.Resize(lastRow, numcolumns + 4).Select
            Selection.Copy
            Range("A2").Select
            ws.Paste
        End If

    '(8) Enter active sheet name in Column E (WORKS)
        If ws.Range("A2") = "" Then
        Else
            Dim lastRow2 As Long
            With ws
                lastRow2 = .Cells(.Rows.Count, "d").End(xlUp).Row
            End With
            Range("E2").Select
            Selection.Resize(lastRow2 - 1).Select
            Selection = ws.Name
        End If

    Next ws
End Sub