Crear archivos macro con formato y dos hojas
Buenos días,
Necesito ayuda para crear una macro capaz de hacer lo siguiente:
Tengo una lista de datos, nombre, dirección, y al lado de cada una le pongo a que cliente se la quiero enviar.
Ej:
A B C
1 Nombre Dirección Asignado a
2 pepe c din 8 GOOGLE
3 ana c zor 4 GOOGLE
4 julia c bel 1 YAHOO
Y asi sucesivamente.
Pues necesito que una vez ingrese a quien esté asignado,con la macro se me peguen en diferentes libros (no hojas) los datos de cada asignación (ej: una hora que tenga todo el listado de google, otro el de yahoo..) y que se guarde con el nombre y fecha (ej. YAHOO 21-06-2013)
Un usuario me la creó hace unos días, sin embargo necesito que se me peguen en un archivo concreto que tengo, con un formato especifico, que además tiene dos hojas (el archivo es este: http://ge.tt/84jhK7k/v/0?c)
Os adjunto la macro que me hizo el otro experto, pero que le falt
Dim asg As New Collection
Sub asignar()
'Por.DAM
Application.ScreenUpdating = False
Application.DisplayAlerts = False
uf = Range("A" & Rows.Count).End(xlUp).Row
Set h1 = ActiveSheet
Set h2 = Sheets.Add 'criterios
Set h3 = Sheets.Add 'datos
h1.Select
Set asig = Range("C2:C" & uf)
For Each cl In asig
AddItem (cl.Value)
Next
On Error Resume Next
For Each asgs In asg
h2.Cells.Clear
h3.Cells.Clear
h2.Range("A1") = h1.Range("C1")
h2.Range("A2") = asgs
h1.Select
Range("A1:C" & uf).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=h2.Range("A1:A2"), _
CopyToRange:=h3.Range("A1"), Unique:=False
h3.Copy
ActiveWorkbook.SaveAs asgs & " " & Format(Date, "dd-mm-yyyy")
ActiveWorkbook.Close
Next
h2.Delete
h3.Delete
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Asingnación Terminada", vbInformation
End Sub
Sub AddItem(sItem As String)
'Por.DAM agrega los item en orden alfabético
For s = 1 To asg.Count
Select Case StrComp(asg(s), sItem, vbTextCompare)
Case 0: Exit Sub 'ya existe en el combo
Case 1: asg.Add sItem, Before:=s: Exit Sub 'lo agrega en la fila m
End Select
Next
asg.Add sItem 'lo agrega al final
End Sub