With my poor knowledge, I changed (added another part). Miraculously works, but not correctly. It copies one extra row. After the last row that contains something in column B. Is empty. I do not need it.

Sub test()
    Dim ws As Worksheet, i As Long, x As Range
    Application.ScreenUpdating = False
    With Sheets("CONTROL")
    .Select
        For Each ws In Worksheets(Array("Sheet", "Sheet (2)", "Sheet (3)", "Sheet (4)", "Sheet (5)", "Sheet (6)"))
            If ws.Name <> Me.Name Then
                With ws.Range("b9").CurrentRegion
                    For i = 1 To .Rows.Count Step 2
                        If x Is Nothing Then
                            Set x = .Rows(i).EntireRow.Range("b1,g1:h1")
                        Else
                            Set x = Union(x, .Rows(i).EntireRow.Range("b1,g1:h1"))
                        End If
                    Next
                End With
                If Not x Is Nothing Then
                    .Range("b" & Rows.Count).End(xlUp)(2).Select
                    x.Copy
                    Me.Paste link:=True
                End If
                Set x = Nothing
            End If
        Next
        For Each ws In Worksheets(Array("Sheet", "Sheet (2)", "Sheet (3)", "Sheet (4)", "Sheet (5)", "Sheet (6)"))  '  Modified by me
            If ws.Name <> Me.Name Then  '  Added by me
                With ws.Range("b8").CurrentRegion  '  Added by me
                    For i = 2 To .Rows.Count Step 2  '  Added by me
                        If x Is Nothing Then '  Added by me
                            Set x = .Rows(i).EntireRow.Range("z1,aa1") '  Added by me
                        Else '  Added by me
                            Set x = Union(x, .Rows(i).EntireRow.Range("z1,aa1")) '  Added by me
                        End If '  Added by me
                    Next '  Added by me
                End With
                If Not x Is Nothing Then
                    .Range("e" & Rows.Count).End(xlUp)(2).Select
                    x.Copy
                    Me.Paste link:=True
                End If
                Set x = Nothing
            End If
        Next
        .[b3].Select
    End With
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub
Any help, no matter how small .. is greatly appreciated.