Macro que se repita en todo el libro

Tengo la siguiente macro
Sub Copiar()
    ActiveWindow.DisplayHeadings = True
    Columns("E:G").Select
    Selection.EntireColumn.Hidden = False
    Range("C5").Select
    While ActiveCell.Value <> Empty
    If ActiveCell.Value = "1" Then
    Selection.EntireRow.Copy
    Windows("Pendientes.xls").Activate
    Worksheets("Pendientes").Select
    Range("A65000").End(xlUp).Offset(1, 0).Select
    Selection.Insert Shift:=xlDown
    Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
    Application.CutCopyMode = False
End If
    Windows("Clientes.xls").Activate
    ActiveCell.Offset(1, 0).Select
Wend
Windows("Clientes.xls").Activate
    ActiveWindow.DisplayHeadings = False
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = True
    Range("C4").Select
End Sub
La cual quiero que se repita en las hojas siguientes del libro y se detenga al encontrar la hoja final, espero me puedan ayudar.
Saludos desde la cuidad más contaminada de México (DF)

1 Respuesta

Respuesta
-1
Tendrías que hacer un bucle que reapase todas las hojas del Libro Pendientes.xls para que en cada una de ellas repitas el código de copia y pega desde el Libro Clientes.xls
La instrucción para ello es:
Declaramos la variable:
Dim i As Integer
Creamos el bucle para abrir todas las hojas:
For i = 1 To Worksheets.Count
'Tu codigo en cada hoja
Next 'Para repetir en la siguiente hoja.
Espero que te sirva.
>Un saludo
>Julio
Buenos días Julio, El lbro "Clientes" tiene 2 hojas de instrucciones, a partir de la tercera hoja que llamo "A" es donde quiero que se ejecute la macro hasta la letra "Z".
Ya agregue el bucle, pero únicamente se copian las filas de la hoja "A" y se repiten las mismas filas de la hoja "A" ´"N" veces como hojas tengo.
Te debo aclarar que soy novato en esto, por lo que te mando el código y me ayudes nuevamente de favor.
Sub CopiarPend()
    Windows("Clientes.xls").Activate
    Worksheets("A").Select
Dim i As Integer
For i = 1 To Worksheets.Count
    ActiveWindow.DisplayHeadings = True
    Columns("E:G").Select
    Selection.EntireColumn.Hidden = False
    Range("C5").Select
    While ActiveCell.Value <> Empty
    If ActiveCell.Value = "1" Then
    Selection.EntireRow.Copy
    Windows("Pendientes.xls").Activate
    Worksheets("Pendientes").Select
    Range("A65000").End(xlUp).Offset(1, 0).Select
    Selection.Insert Shift:=xlDown
    Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
    Application.CutCopyMode = False
End If
    Windows("Clientes.xls").Activate
    ActiveCell.Offset(1, 0).Select
Wend
    Windows("Clientes.xls").Activate
    ActiveWindow.DisplayHeadings = False
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = True
    Range("C4").Select
Next
   End Sub
Saludos
AR
Pues solo poner el nombre de las dos hojas para que en ellas no se ejecute la macro:
Sub CopiarPend()
    Windows("Clientes.xls").Activate
    Worksheets("A").Select
Dim i As Integer
For i = 1 To Worksheets.Count
nombre = Sheets(i).Name
If nombre <> "Nombre de una hoja" Or nombre <> "De la otra hoja" Then

    ActiveWindow.DisplayHeadings = True
    Columns("E:G").Select
    Selection.EntireColumn.Hidden = False
    Range("C5").Select
    While ActiveCell.Value <> Empty
    If ActiveCell.Value = "1" Then
    Selection.EntireRow.Copy
    Windows("Pendientes.xls").Activate
    Worksheets("Pendientes").Select
    Range("A65000").End(xlUp).Offset(1, 0).Select
    Selection.Insert Shift:=xlDown
    Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
    Application.CutCopyMode = False
End If
    Windows("Clientes.xls").Activate
    ActiveCell.Offset(1, 0).Select
Wend
    Windows("Clientes.xls").Activate
    ActiveWindow.DisplayHeadings = False
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = True
    Range("C4").Select
End If
Next
   End Sub
Con estas 3 lineas de código poniendo el nombre de las 2 hojas en las que no quieres que se ejecute la macro se hará lo que necesitas.
>Un saludo
>Julio
Buenos días Julio:
Ya la copié e hice los cambios que me sugeriste pero al ejecutar la macro me dice que:
"Error de compilación: No se ha definido la variable" . y me manda al editor subrayando con negro "nombre ="
     Windows("Clientes.xls").Activate
     Worksheets("A").Select
Dim i As Integer
For i = 1 To Worksheets.Count
     nombre = Sheets(i).Name
If nombre <> "Ayuda" Or nombre <> "Índice" Then
De nuevo, gracias por tu amable tiempo,
Saludos.
Correcto mis lapsus de no declarar las variables hasta el final y siempre se me pasan algunas, quedaría así:
Sub CopiarPend()
    Windows("Clientes.xls").Activate
    Worksheets("A").Select
Dim i As Integer
Dim nombre As String
For i = 1 To Worksheets.Count
nombre = Sheets(i).Name
If nombre <> "Nombre de una hoja" Or nombre <> "De la otra hoja" Then
    ActiveWindow.DisplayHeadings = True
    Columns("E:G").Select
    Selection.EntireColumn.Hidden = False
    Range("C5").Select
    While ActiveCell.Value <> Empty
    If ActiveCell.Value = "1" Then
    Selection.EntireRow.Copy
    Windows("Pendientes.xls").Activate
    Worksheets("Pendientes").Select
    Range("A65000").End(xlUp).Offset(1, 0).Select
    Selection.Insert Shift:=xlDown
    Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
    Application.CutCopyMode = False
End If
    Windows("Clientes.xls").Activate
    ActiveCell.Offset(1, 0).Select
Wend
    Windows("Clientes.xls").Activate
    ActiveWindow.DisplayHeadings = False
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = True
    Range("C4").Select
End If
Next
   End Sub
La linea en negrita me la comí...
>Un saludo
>Julio
Se ejecuta la macro pero copiando unicamente lo de la hoja "A" pero no copia lo de las demás hojas.
Saludos.
Aclarame que pones aquí:
If nombre <> "Nombre de una hoja" Or nombre <> "De la otra hoja" Then
A ver si este es tu error.
>Un saludo
>Julio

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas