Como unir varias macros en una sola

Tengo varias macros y deseo unirlas todas en una sola para ejecutarla en 100 archivos abiertos por ejemplo tengo una macro que me cambia parámetros tengo otra que borra la ultima linea de la hoja que tiene un parámetro ref tengo otra qu copia y pega el encabezado de un archivo a otro te mando los códigos por favor para que me ayudes, si en el código puedes mejorar algo me dices por ejemplo el que borra la ultima linea que tiene ref en todos los archivos yo la ejecuto y me borra pero me queda seleccionado las celdas que borro me gustaría que al ejecutar toda esta macro unida al final me guarde los cambios que hago gracias te pongo el código

Macro 1

BORRAR REF
Public libro3
Sub Llamaborrar()
libro2 =
ActiveWorkbook.Name
For Each wb
In Workbooks
wb.Activate
Call borrar
Next
End Sub
Sub
borrar()
' borrar
Macro
Columns("CT:CT").Select
Selection.Delete Shift:=xlToLeft
End Sub

macro 2

Sub Macro1()
Cells.Replace
What:="HIJO(A)", Replacement:="HIJO (A)", LookAt:=xlPart, _
SearchOrder:=xlByRows,
MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace
What:="NIETO(A)", Replacement:="NIETO (A)", LookAt:=xlPart,
_
SearchOrder:=xlByRows,
MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace
What:="HERMANO(A)", Replacement:="HERMANO (A)",
LookAt:=xlPart, _
SearchOrder:=xlByRows,
MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace
What:="SOBRINO(A)", Replacement:="SOBRINO (A)",
LookAt:=xlPart, _
SearchOrder:=xlByRows,
MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace
What:="PRIMO(A)", Replacement:="PRIMO (A)", LookAt:=xlPart,
_
SearchOrder:=xlByRows,
MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace
What:="ABUELO(A)", Replacement:="ABUELO (A)",
LookAt:=xlPart, _
SearchOrder:=xlByRows,
MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace
What:="SUEGRO(A)", Replacement:="SUEGRO (A)",
LookAt:=xlPart, _
SearchOrder:=xlByRows,
MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace
What:="CUÑADO(A)", Replacement:="CUÑADO (A)",
LookAt:=xlPart, _
SearchOrder:=xlByRows,
MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub

Macro copia y pega no se si esta macro se pueda unir a estos otros debido que esta se ejecuta teniendo el archivo abierto que se llama registro inicial.

Sub COPIA_PEGA()
Range("A1:CS1").Copy
For Each wb In Workbooks
ActiveWindow.ActivateNext
Range("A1").Select
ActiveSheet.Paste
Next
End Sub

1 Respuesta

Respuesta
1

1. Abre todos tus libros

2. Abre el archivo registro inicial y pon la macro

3. Ejecuta la macro

Sub varias()
'Por.DAM
    Set l1 = ThisWorkbook.ActiveSheet
    ml = ThisWorkbook.Name
    For Each wb In Workbooks
        If wb.Name <> ml Then
            wb.Activate
            Columns("CT:CT").Delete Shift:=xlToLeft
            ActiveSheet. Cells. Replace "NIETO(A)", "NIETO (A)"
            ActiveSheet. Cells. Replace "HERMANO(A)", "HERMANO (A)"
            ActiveSheet. Cells. Replace "SOBRINO(A)", "SOBRINO (A)"
            ActiveSheet. Cells. Replace "PRIMO(A)", "PRIMO (A)"
            ActiveSheet. Cells. Replace "HIJO(A)", "HIJO (A)"
            ActiveSheet. Cells. Replace "ABUELO(A)", "ABUELO (A)"
            ActiveSheet. Cells. Replace "SUEGRO(A)", "SUEGRO (A)"
            ActiveSheet. Cells. Replace "CUÑADO(A)", "CUÑADO (A)"
            L1. Range("A1:CS1"). Copy wb. ActiveSheet. Range("A1")
        End If
    Next
    l1.Activate
End Sub

Prueba y me comentas
Saludos. DAM
Si es lo que necesitas.

ok voy a probar

Bien, avísame

oye no veo la parte donde tengo que borar la ultima celda toda esa macro es para ejecutar pero tambien me aparece al final del documento una columna llena de ref necesti borrar esto en los 100 archivos que voy a ajecutar la macro me podrias ayudar gracias

En esta línea hace el borrado

Columns("CT:CT").Delete Shift:=xlToLeft

Lo único que hice fue unir tus macros, dime qué parte de tus macros es la que falta.

Si requires algo adicional lo revisamo.

Para guardar los cambios, quedaría así

Sub varias()
'Por.DAM
    Set l1 = ThisWorkbook.ActiveSheet
    ml = ThisWorkbook.Name
    For Each wb In Workbooks
        If wb.Name <> ml Then
            wb.Activate
            Columns("CT:CT").Delete Shift:=xlToLeft
            ActiveSheet. Cells. Replace "NIETO(A)", "NIETO (A)"
            ActiveSheet. Cells. Replace "HERMANO(A)", "HERMANO (A)"
            ActiveSheet. Cells. Replace "SOBRINO(A)", "SOBRINO (A)"
            ActiveSheet. Cells. Replace "PRIMO(A)", "PRIMO (A)"
            ActiveSheet. Cells. Replace "HIJO(A)", "HIJO (A)"
            ActiveSheet. Cells. Replace "ABUELO(A)", "ABUELO (A)"
            ActiveSheet. Cells. Replace "SUEGRO(A)", "SUEGRO (A)"
            ActiveSheet. Cells. Replace "CUÑADO(A)", "CUÑADO (A)"
            L1. Range("A1:CS1"). Copy wb. ActiveSheet. Range("A1")
        End If
    Next
    L1. Activate
    L1. Save
End Sub

saludos.DAM

voy a hacer el cambio, experto otra pregunta usted sabe como hacer una macro que me guarde todos los archivos que tengo abietos xlsm a csv con el mismo nombre yo he encontrado varias macros que lo hacen pero la información del archivo me queda desorganizado , por ejemplo si yo lo hago manualmente por excel archivo guardar como csv delimitado por comas el me lo guarda y me deja organizado todo normal, como el original pero los códigos que he encontrado en la web no me los pasa asi me los desorganiza todo usted bien sabe que yo lo necesito organizado para poder ejecutar las macros de reemplazar HIJO(A) POR HIJO (A) que borre la columna que tiene ref que copie y pegue estructura mejor dicho con lo que usted me ha ayudado lo que necesito es saber como paso los 100 archivos de xlsm a csv pero que quede con la estructura original que no se me desorganice la información y que quede con el mismo nombre de archivo pero en csv delimitado por comas.

Gracias

la macro que uniste no me funciono me saca error en l1.Sabe pruébalas no corre

Utiliza esta macro

Sub varias()
'Por.DAM
    Set l1 = ThisWorkbook.ActiveSheet
    ml = ThisWorkbook.Name
    For Each wb In Workbooks
        If wb.Name <> ml Then
            wb.Activate
            Columns("CT:CT").Delete Shift:=xlToLeft
            ActiveSheet. Cells. Replace "NIETO(A)", "NIETO (A)"
            ActiveSheet. Cells. Replace "HERMANO(A)", "HERMANO (A)"
            ActiveSheet. Cells. Replace "SOBRINO(A)", "SOBRINO (A)"
            ActiveSheet. Cells. Replace "PRIMO(A)", "PRIMO (A)"
            ActiveSheet. Cells. Replace "HIJO(A)", "HIJO (A)"
            ActiveSheet. Cells. Replace "ABUELO(A)", "ABUELO (A)"
            ActiveSheet. Cells. Replace "SUEGRO(A)", "SUEGRO (A)"
            ActiveSheet. Cells. Replace "CUÑADO(A)", "CUÑADO (A)"
            L1. Range("A1:CS1"). Copy wb. ActiveSheet. Range("A1")
            Wb. Save
        End If
    Next
    l1.Activate
End Sub

Saludos.DAM

Terminemos con el punto de unir las macro y luego seguimos con las otras peticiones, ¿te parece?

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas