consulta

hace un tiempo me ayudaron con esta consulta mira tengo un
problema la estoy intentando volver a hacer pero tengo problemas, lo que hace
la rutina es agrega la hoja, y de ahi elmina lo que tengo en la consulta a o
a veces me sale un error que dice solo 400, en la primera columna tengo los
numeros de identificacion de las empresas que son codigos unicos, y una vez
que agrega la hoja la ruitina elmina esos codigos te adjunto la rutina que me
enviaste y se planta ahi, espero me puedas ayudar
mi pregunta original fue "buenas tengo datos en varias columnas ejemplo
Columna A nombres de empresas
que se repiten en varias filas, en total son 10,0000, en la columna b tengo
nombres de distintas personas que trabajan en una empresa, vale decir si
tengo la empresa papita que se repite en varias filas, de una columna en la
otras los nombres de distintos vendedores, de esa empresa en la otra columna
sus correos, como puedo hacer para dejar todo los nombres y los correos en
una misma fila no se si me dejo entender?
ojala me puedan ayudar
Gracias"

Sub Empresa_por_fila()
Application.ScreenUpdating = False
Dim Fila As Integer, Celda As Range, Col As Byte
Worksheets.Add
With Worksheets("hoja11")
If .AutoFilterMode Then .Cells.AutoFilter
' .Range("a1").CurrentRegion.Sort _
Key1:=.Range("a1"), Order1:=xlAscending, _
Key2:=.Range("b1"), Order2:=xlAscending, Header:=xlYes
.Columns("a").AdvancedFilter xlFilterCopy, , Range("a1"), True
For Fila = 2 To Range("a" & Rows.Count).End(xlUp).Row
.Range("a1").AutoFilter Field:=1, Criteria1:=Range("a" & Fila)
Col = 2
With .AutoFilter.Range
For Each Celda In .Offset(1).Resize(.Rows.Count - 1,
1).SpecialCells(xlCellTypeVisible)
Celda.Offset(, 1).Resize(, 3).Copy Cells(Fila, Col)
Col = Col + 3
Next
End With
Next
If .AutoFilterMode Then .Cells.AutoFilter
End With
End Sub