select yr Comp ID's 1st column in Sheet1 and try the following macro:

Sub polacz_listy()
For Each cell In Selection
For i = 2 To 20000
If Sheets("Arkusz2").Cells(i, 1) = cell Then
Sheets("Arkusz2").Cells(i, 1).Rows.EntireRow.Copy
Sheets("Arkusz3").Cells(licznik + i, 1) = cell
Sheets("Arkusz3").Cells(licznik + i + 1, 1).PasteSpecial
Paste:=xlValues
'Sheets("Arkusz3").Rows(i).EntireRow =
Sheets("Arkusz1").Rows(cell.Row).EntireRow
licznik = licznik + 1
End If
Next i
Next cell
End Sub

the result will be in Sheet3 so make sure it is in place before you
start the macro
adjust the figure "20000" in the loop to yr needs, macro runs till row
number 20000

HIH