Excel: uso de las macros

Buenos dias,Expertos
En mi computadora tengo instalado Excel 2007.
Mi problema es el siguiente.Tengo una carpeta con varios archivos con formato excel 2003 .(La carpeta posee,a su vez, subcarpetas con estos archivos).
Cada archivo tiene un nombre diferente.
Cada archivo contiene una sola hoja con el nombre Contactos
El formato de la hoja es el siguiente:3 columnas con los siguientes nombres:
Telefono Direccion Nombre (A1,B1. Y C1) .
Estas celdas tienen relleno gris.Tengo datos SOLAMENTE en la columna A (desde el  A2 hasta el A9999.La cantidad varia con el archivo).  
Las columnas A,B y C tienen marcados todos los bordes.
Tengo que cambiar SOLAMENTE la estructura de la hoja a lo siguiente:
TELEFONO DATA CAMPO1 CAMPO2 CAMPO3 CAMPO4 CAMPO5 CAMPO6 CAMPO7 CAMPO8 CAMPO9 CAMPO10 (A1.....L1).
Estas celdas siguen con el relleno gris y los bordes marcados desde la celda A1 hasta la L1.
Los datos de la columna A (desde A2 hasta A9999)deben seguir como estan,como tambien el nombre de la hoja y el nombre del archivo.
Cambiarlos uno por uno me llevaria una eternidad por el tiempo.
Mi pregunta es: Como seria una macro que aplique estos cambios a todos los archivos sin tener que abrir cada uno de ellosy realizar los cambios uno por uno.
Espero haberme explicado bien y desde ya muchas gracias por su tiempo.

1 respuesta

Respuesta
1
Te hago dos consultas solamente, ¿los bordes que tiene que aparecer son solamente en la fila a1 a L1 y pintadas en gris?
¿Eso qué pusiste como campo1 tiene que ir hasta L1 de manera correlativa?
Antes que nada muchas gracias por tu tiempo !!
Las celdas que deben tener bordes son TODAS las columnas d3sde la A hasta la L.
Las que van coloreadas son solo las de la primera Fila desde la A1 hasta la L1.
La primera fila seria TELEFONO (A1,coloreada de gris)
DATA (B1coloreadade gris)
CAMPO1(C1,coloreada de gris)
asi sucesivamente hasta
CAMPO10 (L1,coloreada de gris)
Espero haber contestado tu duda.Cualquier otra consulta a tus ordenes.Y de nuevo muchas gracias.
Bueno vamos a hacer una cosa, para que una macro haga el trabaj hay que poner la ubicacion del archivo, pero para que no lo haga de manera engorrosa, osea cambiandolo cada vez que abras un archivo lo que vamos a hacer es crear en un libro1 y lo guardamos como libro1. Luego en la hoja1 de este libro escribiras en la celda A1 hasta la celda L1 lo que queres que ponga en las otras hojas y lo coloreamos en gris asi lo unico que hara la macro sera pegar los valores y nada mas.
Una vez concluido esto tenemos que poner la ubicacion del archivo en la hoja, entonces en A3 pondremos C:\Documents and Settings\Juan\Mis documentos (Aqui pon la carpeta donde se encuentran las demas sub carpetas). Luego en B3 pondremos el nombre de la subcarpeta que haremos primero =A3&"\Mis imágenes\" (Aqui pon la subcarpeta con la que empezamos) y luego en C3 pondremos el archivo que abriremos libro4, de aqui para abajo, en C4 ponemos otro archivo, en C5 ponemos otro archivo digamos hasta C12 porque sino se puede poner muy lenta la maquina, no te preocupes si esa carpeta tiene menos archivos de archivos, solo pon los que tengas, si los superas hace esos 10 y luego cambialos por los otros que tengas.
Una vez que termines con esto en la celda D3 hacia abajo pon la siguiente formula
SI(C3=0;0;$B$3&$C3&".xlsm") una vez concluido esto ya podemos hacer la macro
Pones grabar macro y luego la detienes vas a paso a paso e insertas esta macro
Sub Macro1()
'
' Macro1 Macro
' Macro grabada el 03/03/2011 por Juan Manuel
'
' Acceso directo: CTRL+q
'
Application.ScreenUpdating = False
'''''''' Carpeta General
    a = Range("a3")
'''''''' Subcarpeta
    b = Range("B3")   'Subcarpeta
'''''''' Abrir Archivo
    d = Range("d3")   'Archivo 1
    e = Range("c3")   ' Nombre Archivo 1
    f = Range("d4")   'Archivo 2
    g = Range("c4")   'Nombre Archivo 2
    h = Range("d5")   'Archivo 3
    i = Range("c5")   'Nombre Archivo 3
    j = Range("d6")   'Archivo 4
    k = Range("c6")   'Nombre Archivo 4
    l = Range("d7")   'Archivo 5
    m = Range("c7")   'Nombre Archivo 5
    n = Range("d8")   'Archivo 6
    ñ = Range("c8")   'Nombre Archivo 6
    o = Range("d9")   'Archivo 7
    p = Range("c9")   'Nombre Archivo 7
    q = Range("d10")   'Archivo 8
    r = Range("c10")   'Nombre Archivo 8
    s = Range("d11")   'Archivo 9
    t = Range("c11")   'Nombre Archivo 9
    u = Range("d12")   'Archivo 10
    v = Range("c12")   'Nombre Archivo 10
    If Range("d3") = 0 Then
    End If
    If Range("d3") > 0 Then
    ChDir _
         b
    Workbooks.Open Filename:= _
        d _
        , UpdateLinks:=0
    Windows("Libro1.xls").Activate
    Range("a1:l1").Select
    Selection.Copy
    Windows(e & ".xls").Activate
    Range("a1").Select
    ActiveSheet.Paste
    Range("a1:l9999").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    End If
    If Range("d4") = 0 Then
    End If
    If Range("d4") > 0 Then
    ChDir _
         b
    Workbooks.Open Filename:= _
        f _
        , UpdateLinks:=0
    Windows("Libro1.xls").Activate
    Range("a1:l1").Select
    Selection.Copy
    Windows(g & ".xls").Activate
    Range("a1").Select
    ActiveSheet.Paste
    Range("a1:l9999").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    End If
        If Range("d5") = 0 Then
    End If
    If Range("d5") > 0 Then
    ChDir _
         b
    Workbooks.Open Filename:= _
        h _
        , UpdateLinks:=0
    Windows("Libro1.xls").Activate
    Range("a1:l1").Select
    Selection.Copy
    Windows(i & ".xls").Activate
    Range("a1").Select
    ActiveSheet.Paste
    Range("a1:l9999").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    End If
        If Range("d6") = 0 Then
    End If
    If Range("d6") > 0 Then
    ChDir _
         b
    Workbooks.Open Filename:= _
        j _
        , UpdateLinks:=0
    Windows("Libro1.xls").Activate
    Range("a1:l1").Select
    Selection.Copy
    Windows(k & ".xls").Activate
    Range("a1").Select
    ActiveSheet.Paste
    Range("a1:l9999").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    End If
        If Range("d7") = 0 Then
    End If
    If Range("d7") > 0 Then
    ChDir _
         b
    Workbooks.Open Filename:= _
        l _
        , UpdateLinks:=0
    Windows("Libro1.xls").Activate
    Range("a1:l1").Select
    Selection.Copy
    Windows(m & ".xls").Activate
    Range("a1").Select
    ActiveSheet.Paste
    Range("a1:l9999").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    End If
        If Range("d8") = 0 Then
    End If
    If Range("d8") > 0 Then
    ChDir _
         b
    Workbooks.Open Filename:= _
        n _
        , UpdateLinks:=0
    Windows("Libro1.xls").Activate
    Range("a1:l1").Select
    Selection.Copy
    Windows(ñ & ".xls").Activate
    Range("a1").Select
    ActiveSheet.Paste
    Range("a1:l9999").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    End If
        If Range("d9") = 0 Then
    End If
    If Range("d9") > 0 Then
    ChDir _
         b
    Workbooks.Open Filename:= _
        o _
        , UpdateLinks:=0
    Windows("Libro1.xls").Activate
    Range("a1:l1").Select
    Selection.Copy
    Windows(p & ".xls").Activate
    Range("a1").Select
    ActiveSheet.Paste
    Range("a1:l9999").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    End If
        If Range("d10") = 0 Then
    End If
    If Range("d10") > 0 Then
    ChDir _
         b
    Workbooks.Open Filename:= _
        q _
        , UpdateLinks:=0
    Windows("Libro1.xls").Activate
    Range("a1:l1").Select
    Selection.Copy
    Windows(r & ".xls").Activate
    Range("a1").Select
    ActiveSheet.Paste
    Range("a1:l9999").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    End If
        If Range("d11") = 0 Then
    End If
    If Range("d11") > 0 Then
    ChDir _
         b
    Workbooks.Open Filename:= _
        s _
        , UpdateLinks:=0
    Windows("Libro1.xls").Activate
    Range("a1:l1").Select
    Selection.Copy
    Windows(t & ".xls").Activate
    Range("a1").Select
    ActiveSheet.Paste
    Range("a1:l9999").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    End If
        If Range("d12") = 0 Then
    End If
    If Range("d12") > 0 Then
    ChDir _
         b
    Workbooks.Open Filename:= _
        u _
        , UpdateLinks:=0
    Windows("Libro1.xls").Activate
    Range("a1:l1").Select
    Selection.Copy
    Windows(v & ".xls").Activate
    Range("a1").Select
    ActiveSheet.Paste
    Range("a1:l9999").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    End If
End Sub
Ya seria todo espero te sirva, cualquier duda me avisas
Queria saber si te sirvio al respuesta o necesitas mas ayuda, ya que esta todavia esta abierta
Hola experto !!!
He armado la macro tal cual me indicaste y me aparecen algunos errores que te indicare en estos dias.(aun no se si los errores son debido a la macro o a mi).
De todos modos te agradezco infinitamente tu aporte y tus conocimientos ya que me han sido de gran ayuda.
Ok cualquier duda me consultas, sino te armo el libro y te lo envio por email
Hola experto !!
No consigo formar la macro en forma correcta.Podrias armarme el libro?
Muchas gracias por tu tiempo.
Ok te voy a armar el libro, mandame un email a [email protected] asi te lo envio ni bien lo termine, luego avisame que me lo mandastes por este medio
Queria saber si me mandastes el email, porque si es asi no me llego para enviarte el email
Aun no me ha llegado tu correo para poder mandarte el libro, nose si resolvistes el problema o has estado muy ocupado, necesitaria que me lo confirmes
Estimado dado_7
Disculpame el tiempo,pero estuve con algunos problemas personales.
He realizado nuevamente lo que me has indicado y me ha funcionado de maravillas.
Te agradezco infinitamente por tu tiempo,trabajo y paciencia.
Saludos cordiales

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Bordes con macro

Recurro a ustedes una vez mas. Tengo una simple macro que dibuja bordes negros en el exterior y grises en el interior ( un formato que uso muy habitualmente ) Funciona correctamente salvo en la ocasión en que solo tenga seleccionada una sola celda:...
1 respuesta

DIBUJAR CELDAS con macros

Tengo una Base de Datos en la que estoy asignando valores por medio de un UserForm de la sig forma: ActiveCell = TextBox1 '(TextBox2, ComboBox1, etc, etc..) El UserForm llena toda una fila de mil columnas en la base de datos. Y me gustaría poner una...
1 respuesta

Problemas con un proceso de excel

Primero me presento pues soy nuevo en este foro. He encontrado por la web un montón de temas que hacen referencia al tema planteado, pero ninguno logra solucionarme el problema. El problema es el siguiente. Abro un libro de excel, y según los datos...
2 respuestas

Macro para Imprimir hoja en impresora que no es la predeterminada.

Me podrían ayudar a generar una macro para imprimir una un archivo en dos paginas y mandarla a otra impresora que no es la predeterminada, Tengo varias impresoras en red y la que uso predeterminada es una impresora matriz, el tema es que el reporte...
1 respuesta

Macro que Crea PDF y Envía El PDF por Outlook

De la manera más amable solicito ayuda, ya he creado una macro que me permite hacer un archivo en PDF, lo que requiero es que el archivo que fue creado sea enviado vía por medio de Outlook. Adjunto código de la macro para crear el PDF. Sub...
1 respuesta

Crear bordes

Respetuoso para todos y todas. Quiero darle borde a una cantidad no definida de filas y columnas, ¿Cómo se genera el código para lograrlo?
1 respuesta

Selección de varios rangos para aplicar formato

Bueno me voy de frente a explicar la macro que deseo hacer, primero debe seleccionar un rango dado pejm (B6:F30), ahora seleccionar rangos dentro de este pejm (B6:F6) aplicarle negrita, centrado y todo los bordes; (B7:B30) aplicarle borde externo;...
1 respuesta

Bordes de caldas

Como puedo obtener el formato de bordes de las celdas de excel mediante VB, yo lo probé así: Cells(1, 1). Borders Pero cuando la celda no tiene borde me da valor negativo, cuando le pongo un marco me da 1 pero con otros estilos em da nulo... ¿Cuál es...
1 respuesta