Crear hojas y pegar filas

A ver para aplicar esta macro presiona alt+f11 te aparecerá la pantalla de visula basic en la parte izquierda das click derecho y en insertar presinas en modulo, ta aparecerá una pantalla en blanco ahí pegas la macro que está a continuación. Luego en la hoja1 insertas cualquier objeto, sea una gráfico un autoforma una foto... Lo que quieras, en este objeto le das click derecho y eliges asignar macro, y luego te aparecerá una pantalla con todas las macros que tengas, deberás escoges para este caso Copia_Pega, que es el nombre que le he dado a la macro
Para mi ejemplo la hoja en la que tienes todos los datos de los proveedores con sus respectivos artículos se llama hoja1 y los archivos te los guarda en el C:
Desde la siguiente linea debes copiar la macro y pegarla en tu hoja
Sub Copia_Pega()
Sheets("Hoja1").Select
    Columns("A:A").Select
    Range("A1:A65000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "D1"), Unique:=True
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C[-1]:R[64999]C[-1])"
    a = Range("E1").Value
    Cells.Select
    Selection.AutoFilter
    b = 1
    For i = 1 To a
    b = b + 1
    c = Range("D" & b).Value
    Cells.Select
    ActiveSheet.Range("$A$1:$D$65000").AutoFilter Field:=2, Criteria1:=c
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Columns("D:E").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
     Range("A1").Select
    ActiveWorkbook.SaveAs Filename:="C:\" & c & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    Next i
    Selection.AutoFilter
    Columns("D:E").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
MsgBox "Se han creado " & a & " Archivos en la ubicación C:/"
End Sub

Buenas tardes, ante todo muchas cracias por el tiempo dedicado a responder.
Por otro lado, la macro me genera un error que no se a que es debido, me dice:
Se ha producido el error '1004' en tiempo de ejecución:
El rango de extracción tiene un nombre de campo inexistente o no permitido.


Luego ejecutando el depurador me marca en amarillo lo siguiente:
Range("A1:A65000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "D1"), Unique:=True

Gracias.

Yo probé la macro y funciona, toma las siguientes consideraciones:
La hoja no debe estar bloqueada
El objeto que corre la macro debe estar en la hoja en la que tienes los datos de los proveeedores y sus artículos.
¿La columna DE no debe tener datos
Y solo por preguntar que version de office tienes?

Buenas tardes, gracias de nuevo por contestar. Bueno te cuento, la version es 2003 y la verdad que el ejemplo que puse no esta del todo completo, tengo datos hasta la columna "R" inclusive. De todas maneras he probado la macro eliminando las columnas a partir de la "D" y me da otro error nuevo:
Se ha producido el error '1004' en tiempo de ejecución:

Error en el método "sabe as" de objeto "_workbook"
El depurador me marca la siguiente linea:
ActiveWorkbook.SaveAs Filename:="C:\" & c & ".xlsx", FileFormat:=xlOpenXMLWorkbook,
Mil gracias.

Pues si el prbema es tu office, yo te estoy pasando códigos para office mínimo 2007, pero has lo siguiente, me parece que en la pestaña de datos esta la grabadora de macros, lo que necesito es que grabes una macro, ¿cómo se hace? Pues vas a datos presionas grabar macro y luego predionas F12, pones cualquier nombre al nuevo archivo y listo, vas otra vez a datos y pones detener macro, por ultimo vas a visual y me pasas los códigos que hayas grabado para insertarlos en la macro. Sobre lo otro dime desde que columna esta libre para adaptar la macro.

Buenos días, la columna que queda libre es la "s".
Y aquí te copio la macro grabada.
Sub Macro1()
'
' Macro1 Macro
' Macro grabada el 09/05/2011 por TOSHIBA
'
'
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Cells.Select
    Selection.Copy
    Sheets("Hoja2").Select
    Cells.Select
    ActiveSheet.Paste
End Sub
Gracias de nuevo.

LO que debías grabar es el guardar un archivos, has grabado la copia y el pegado en la hoja 2.
Mira abre la grabadora y luego sin hacer nada más, presiona F12 da click en guardar y luego detén la grabadora, y me pasas esos códigos, como dato te podría decir que te fijes al momento de activar la grabadora como se llama la macro (Ejm:Macro1;Macro2... etc) esto con el fin de que copies la macro que corresponde.

Ok, aquí lo tienes, espero que sea esto lo que hace falta, siento no entenderlo a la primera.
Sub Macro1()
'
' Macro1 Macro
' Macro grabada el 10/05/2011 por TOSHIBA
'
'
    ChDir "C:\Documents and Settings\TOSHIBA\Desktop\MEGA CENTRO"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\TOSHIBA\Desktop\MEGA CENTRO\pedidos.xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Muchas gracias.

Te lo paso corregido
Sub Copia_Pega()
Sheets("Hoja1").Select
    Columns("A:A").Select
    Range("A1:A65000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "D1"), Unique:=True
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C[-1]:R[64999]C[-1])"
    a = Range("E1").Value
    Cells.Select
    Selection.AutoFilter
    b = 1
    For i = 1 To a
    b = b + 1
    c = Range("D" & b).Value
    Cells.Select
    ActiveSheet.Range("$A$1:$D$65000").AutoFilter Field:=2, Criteria1:=c
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Columns("D:E").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
     Range("A1").Select
ChDir "C:\Documents and Settings\TOSHIBA\Desktop\MEGA CENTRO"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\TOSHIBA\Desktop\MEGA CENTRO\" & c & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
    Next i
    Selection.AutoFilter
    Columns("D:E").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
MsgBox "Se han creado " & a & " Archivos en la ubicación C:\Documents and Settings\TOSHIBA\Desktop\MEGA CENTRO"
End Sub
Prueba con estos cambios y me avisas

Buenos días.
Me da "error de compilación, no se ha definido la variable" y me marca en azul
a = Range("E1").Value
Gracias.

Cambia esta parte
Range("E1").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C[-1]:R[64999]C[-1])"
    a = Range("E1").Value
Por:
Range("E1").Formula = "=COUNTA(D:D)"
    a = Range("E1").Value
Me avisas.

Buenas noches, gracias por la dedicación.
Sigue el mismo error.
Gracias.

Prueba colocando esto luego de Sub Copia_Pega()
Dim a As String

Ok, me dio el mismo error, pero esta vez en B=1.
Gracias.

Pues adiciona
Dim b As String
Y me avisas

Vuelve a dar el mismo error, pero en: for i=1 to a.
y colocando Dim i As String, no va.
Gracias.

Solo coloca "Dim i" y me avisas.
Son raros estos problemas yo jamás he determinado este tipo de condiciones a las variantes, pero en fin.

Ok yo tengo paciencia, espero que tu también, y gracias por todo.
Bueno, seguimos mismo error pero con c=, colocando dim c o dim c As String, me da error de compilación no se ha definido la variable, pero la diferencia a los demás errores es que esta vez no me marca nada en azul ni en amarillo.
Gracias.

Si no te marca nada como sabes que error es de la variable "c".
Corre la macro y dime que mensaje de error aparece. Y cuando das depuara dime que te marca

ok, tienes razon. colocando dim c, el error es:
Error de compilación: no se ha definido la variable
Y marca en azul xlOpenXMLWorkbook
Esta es la linea entera:
ActiveWorkbook.SaveAs Filename:="C:\" & c & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Solo para estar seguro cambia en lugar de
ActiveWorkbook.SaveAs Filename:="C:\" & c & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
por
ActiveWorkbook.SaveAs Filename:="C:\" & c & ".xlsm", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Y me cuentas

Pues sigue con el mismo fallo.

ChDir "C:\Documents and Settings\TOSHIBA\Desktop\MEGA CENTRO"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\TOSHIBA\Desktop\MEGA CENTRO\" & c & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Reemplaza esto y me cuentas, porque recordé que al inicio este fue tu problema.