Contador para ejecutar setencia macro

La siguiente sentencia me permite copiar una fila de una hoja a otra

Dim filaUlt As Long 'ejecutamos setencia
Sheets("Hoja1").Select 'seleccionamos hoja
filaUlt = Sheets("Hoja1").Range("A65536").End(xlUp).Row + 1 ' y buscamos la última fila
Range("A" & [A:A].Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Ahora lo que quiero hacer es utilizar la misma rutinna si fuera el caso para copiar datos solo 8 veces (utilizar contador) A partir de la fila B68. Cual seria la modificación o como incluyto el for ...next?

1 Respuesta

Respuesta
2

Pero no entiendo qué necesitas, ¿quieres copiar una fila y pegar la misma fila 8 veces?

¿O quieres copiar 8 filas y pegarlas?

Si es lo primero, no necesitas un for, te anexo la macro, reemplaza tu macro por lo siguiente

    u = Sheets("Hoja1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Hoja1").Range("A" & u & ":A" & u + 7).PasteSpecial Paste:=xlPasteValues

Estimado:

Lo que deseo es mi proceso (rutina enviada) se repita ocho veces nada más por eso asumí que necesita un contador for. o un bucle y luego que me salga un msgbox que diga plantilla llena.

El tema de copiado y pegado ya esta realizado pero necesito un control nada más...

Entonces no entendí bien lo que necesitas.

Podrías explicarlo con ejemplos.

O envíame tu archivo y me explicas paso a paso qué quieres copiar, en dónde quieres pegar, luego qué quieres copiar y en dónde quieres pegar y así me explicas las 8 copias que quieres hacer. Utiliza colores, datos reales y comentarios para tus explicaciones.

Esta es la macro para validar que solamente lo hagas 8 veces

Private Sub CommandButton4_Click()
'Procesar
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja3")
    '
    ruta = "D:\Soporte_Optimiza\"
    'ruta = l1.Path & "\"
    Workbooks.Open ruta & "Acuerdo_de_equipos"
    Set l2 = Workbooks("Acuerdo_de_equipos")
    Set h2 = l2.Sheets("Contrato")
    '
    For i = 68 To 75
        If h2.Cells(i, "B") = "" Then
            h1.Range("B25:H25").Copy h2.Cells(i, "B")
            copia = True
            Exit For
        End If
    Next
    '
    If copia = False Then
        MsgBox "No se puede copiar, se alcanzó el límite de 8", vbCritical
    End If
    l2.Close True
End Sub

Saludos.Dante Amor

Recuerda valorar la respuesta.

Gracias por responder. Tu rutina incluye la apertura del archivo.

Imaginemos que el archivo ya está abierto, entonces la rutina de copiado seria así?

For i = 68 To 75
        If h2.Cells(i, "B") = "" Then
            h1.Range("B25:H25").Copy h2.Cells(i, "B")
            copia = True
            Exit For
        End If
    Next
    '
    If copia = False Then
        MsgBox "No se puede copiar, se alcanzó el límite de 8", vbCritical
    End If

Si ya está abierto, entonces quita esta línea

Workbooks.Open ruta & "Acuerdo_de_equipos"

Experto :

He quitado ya la línea que me indicaste pero sale error en esta línea

Set l2 = Workbooks("Acuerdo_de_equipos")

Pero tienes que tener abierto el "Acuerdo_de_equipos"

Si ya lo tienes abierto prueba con esto

Set l2 = Workbooks("Acuerdo_de_equipos.xlsx")

Si el libro tiene macros entonces:

Set l2 = Workbooks("Acuerdo_de_equipos.xlsm")

Si tienes versión 2033, entonces

Set l2 = Workbooks("Acuerdo_de_equipos.xls")

¡Gracias! Solución excelente. Mil gracias!

Podrías valorar la respuesta.

Al final de mi respuesta dice: “Es una buena respuesta” y puedes seleccionar una de 3 opciones:

  • Excelente
  • Si
  • No

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas