Excel - Copiar filas y pegarlas de manera repetitiva

Pos: 49

Val: 44

Copiar filas y pegarlas de manera repetitiva

Publicado por Carlos (20 intervenciones) el 22/04/2019 14:00:09

Hola a todos.

Estoy creando una base de datos bastante extensa que me ha traído algunas dificultades en su gestión.

Mi consulta es la siguiente:

Quiero copiar 3 filas (Filas 10 a 12) y pegarlas en la fila siguiente (13 a 15) de manera repetitiva hasta la fila 247647. Para tal efecto, he subido una imagen en donde las filas en color amarillo son las que quiero copiar y las de color verde es el lugar donde las quiero pegar.

De antemano agradezco su ayuda.

Valora esta pregunta

Me gusta: Está pregunta es útil y esta clara

No me gusta: Está pregunta no esta clara o no es útil

Responder

Pos: 2

Val: 4.908

Copiar filas y pegarlas de manera repetitiva

Publicado por Antoni Masana (2477 intervenciones) el 23/04/2019 12:41:12

Esta es la macro

Option Explicit

Sub Copiar_Filas()

    Dim a As Long

    Application.ScreenUpdating = False              ' -- Apagar el parpadeo de pantalla

    Application.Calculation = xlCalculationManual   ' -- Apagar los cálculos automáticos

    Application.EnableEvents = False                ' -- Apagar los eventos automáticos

    ActiveSheet.DisplayPageBreaks = False           ' -- Apagar visualización de saltos de página

    Rows("10:12").Select

    Selection.Copy

    For a = 13 To 247647 Step 3

        Rows(a & ":" & a).Select

        ActiveSheet.Paste

        DoEvents         ' --- Evita el efecto de cuelge cuando se ejecuta una macro larga

    Next

    Application.ScreenUpdating = True

    Application.Calculation = xlCalculationAutomatic

    Application.EnableEvents = True

    ActiveSheet.DisplayPageBreaks = True

    Application.CutCopyMode = False                  ' -- Borrar contenido de portapapeles

    MsgBox "Fin de la macro.", vbInformation, "MACRO Copiar Filas"

End Sub

Saludos.
\\//_

Valora esta respuesta

Me gusta: Está respuesta es útil y esta clara

No me gusta: Está respuesta no esta clara o no es útil

Comentar

Pos: 49

Val: 44

Copiar filas y pegarlas de manera repetitiva

Publicado por Carlos (20 intervenciones) el 23/04/2019 14:01:16

Hola Antoni.

En primer lugar agradezco tu ayuda.

La macro esta perfecta pero seguramente no me expliqué bien y la macro no me sirve.

Sucede que debo copiar las filas 10 a 12 en las filas 13 a 15. Luego copiar las filas 24 a 26 y pegar en las filas 27 a 29. Luego copiar las filas 38 a 40 y pegar en las filas 41 a 43. Luego copiar las filas 52 a 54 y pegar en las filas 55 a 57. Y así sucesivamente hasta la fila 247647.

Espero me puedas ayudar.

Saludos ;)

Valora esta respuesta

Comentar

Pos: 2

Val: 4.908

Copiar filas y pegarlas de manera repetitiva

Publicado por Antoni Masana (2477 intervenciones) el 24/04/2019 07:51:24

Si lo entiendo bien primero copia en la fila 13 y después el salto para copiar es 11, 3, 11, 3, 11, 3, ets.

Realizado los cambios:

Option Explicit

Sub Copiar_Filas()

    Dim Dest As Long, Salto As Byte

    Application.ScreenUpdating = False              ' -- Apagar el parpadeo de pantalla

    Application.Calculation = xlCalculationManual   ' -- Apagar los cálculos automáticos

    Application.EnableEvents = False                ' -- Apagar los eventos automáticos

    ActiveSheet.DisplayPageBreaks = False           ' -- Apagar visualización de saltos de página

    Rows("10:12").Select

    Selection.Copy

    Dest = 13

    Salto = 11

    While Dest < 247647

        Rows(Dest & ":" & Dest).Select

        ActiveSheet.Paste

        DoEvents         ' --- Evita el efecto de cuelge cuando se ejecuta una macro larga

        Dest = Dest + Salto

        If Salto = 11 Then Salto = 3 Else Salto = 11

    Wend

    Application.ScreenUpdating = True

    Application.Calculation = xlCalculationAutomatic

    Application.EnableEvents = True

    ActiveSheet.DisplayPageBreaks = True

    Application.CutCopyMode = False                  ' -- Borrar contenido de portapapeles

    MsgBox "Fin de la macro.", vbInformation, "MACRO Copiar Filas"

End Sub

Saludos.
\\//_

Valora esta respuesta

Comentar

Pos: 49

Val: 44

Copiar filas y pegarlas de manera repetitiva

Publicado por Carlos (20 intervenciones) el 24/04/2019 11:35:25

Estimado Antoni.

Nuevamente agradezco tu ayuda, sin embargo creo que no me expliqué bien otra vez.

Para que me puedas entender mejor adjunto parte de la matriz (ya que por su tamaño la web no me permite adjuntarla completa). En ella podrás ver lo siguiente:

Filas subrayadas en amarillo: Son las filas que quiero copiar.
Filas subrayadas en verde: Son las filas donde quiero pegar la información copiada de las filas subrayadas en amarillo.

Como podrás observar en el archivo la secuencia sería la siguiente:

1. Copiar las filas 10 a 12 y pegar en las filas 13 a 15.
2. Copiar las filas 24 a 26 y pegar en las filas 27 a 29.
3. Copiar las filas 38 a 40 y pegar en las filas 41 a 43.
4. Copiar las filas 52 a 54 y pegar en las filas 55 a 57.
5. Copiar las filas 66 a 68 y pegar en las filas 69 a 71.

Y así sucesivamente hasta la fila 247647.

Espero que con esta explicación me puedas ayudar.

Ejemplo.zip(67,4 KB)

Valora esta respuesta

Comentar

Pos: 2

Val: 4.908

Copiar filas y pegarlas de manera repetitiva

Publicado por Antoni Masana (2477 intervenciones) el 24/04/2019 12:57:24

Nueva version:

Option Explicit

Sub Copiar_Filas()

    Dim Orig_Desde As Long, Orig_Hasta As Long, _

        Dest_Desde As Long, Mostrar As Long

    Application.ScreenUpdating = False              ' -- Apagar el parpadeo de pantalla

    Application.Calculation = xlCalculationManual   ' -- Apagar los cálculos automáticos

    Application.EnableEvents = False                ' -- Apagar los eventos automáticos

    ActiveSheet.DisplayPageBreaks = False           ' -- Apagar visualización de saltos de página

    Application.DisplayStatusBar = True

    Orig_Desde = 10

    Orig_Hasta = Orig_Desde + 2

    Dest_Desde = Orig_Desde + 3: Mostrar = 0

    While Orig_Desde <= 247647

        Rows(Orig_Desde & ":" & Orig_Hasta).Select: Selection.Copy

        Rows(Dest_Desde & ":" & Dest_Desde).Select: ActiveSheet.Paste

        If Orig_Desde > Mostrar Then

           Application.StatusBar = "Copiando la línea: " & Orig_Desde

           Mostrar = Mostrar + 500

        End If

        DoEvents         ' --- Evita el efecto de cuelge cuando se ejecuta una macro larga

        Orig_Desde = Orig_Desde + 14

        Orig_Hasta = Orig_Desde + 2

        Dest_Desde = Orig_Desde + 3

    Wend

    Application.ScreenUpdating = True

    Application.Calculation = xlCalculationAutomatic

    Application.EnableEvents = True

    ActiveSheet.DisplayPageBreaks = True

    Application.DisplayStatusBar = False

    Application.CutCopyMode = False                  ' -- Borrar contenido de portapapeles

    MsgBox "Fin de la macro.", vbInformation, "MACRO Copiar Filas"

End Sub

En la barra inferior del Excel muestra por que linea va, salta de 500 en 500 para no perder tiempo en el display por que tarda bastante en ejecutarse.

Saludos.
\\//_

Valora esta respuesta

Comentar

Pos: 49

Val: 44

Copiar filas y pegarlas de manera repetitiva

Publicado por Carlos (20 intervenciones) el 25/04/2019 10:29:53

Hola Antoni.

Gracias por ayudarme, funcionó tal como quería. Realmente eres un crack.

Saludos.

Valora esta respuesta

Comentar

formula suma si otras celdas estan con datos

Problema con tabla dinamica al agregar fecha de formulario