Jump to content
  • Debido a la crisis sanitaria, hasta el día 31 de marzo, el registro al foro de Ayuda Excel será totalmente gratuito para facilitar el teletrabajo. Todos los registros que se produzcan entre estas fechas tendrán acceso gratuito ilimitado a la comunidad hasta el 30 de abril.

    Regístrate

    Si te surge alguna duda mientras estás trabajando en casa con Excel, ya tienes a quien preguntar.

    Espero que esta medida te sirva de ayuda. Frenar la expansión del coronavirus depende de todos. Sé responsable.

JSDJSD

Modificar macro del gran Maestro Gerson Pineda para que pase los comentarios incluidos en la líneas a traspasar

Recommended Posts

Hola Leopoldo, las líneas ya las pasa, lo que quisiera es que al mismo tiempo pasara los comentarios si  hubiera en las líneas traspasadas. En el ejemplo subido existen comentarios en la B2 y la B5.

Share this post


Link to post
Share on other sites

Hola, 

Sub CopiarFilasHojas_GP()
'************ by Gerson Pineda ************
'************ 19/Mayo/2018 ************
'************ Modificación by Leopoldo Blancas ************
'************ 26/Mayo/2018 ************

Application.ScreenUpdating = False
Dim RangoFH As Range: Dim f As Long: Dim Cel As Range
Dim vuf2 As Long: Dim vuf3 As Long: Dim c As Long
    On Error GoTo Error1:
    With Hoja1
        Set RangoFH = .Range("F:F,H:H").SpecialCells(2, 1)
        vuf2 = Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1
        vuf3 = Hoja3.Range("A" & Rows.Count).End(xlUp).Row + 1
        For Each Cel In RangoFH
            f = Cel.Row
            .Range(Cells(f, "A"), Cells(f, "J")).Copy
            Hoja2.Cells(vuf2 + c, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Hoja3.Cells(vuf3 + c, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            c = c + 1
        Next
        Intersect(Range("F:F"), RangoFH).EntireRow.Delete
        Intersect(Range("H:H"), RangoFH).ClearContents
    End With
    If c Then VBA.MsgBox "Total filas copiadas: " & c, vbInformation, "AyudaExcel"
Error1:
    Set RangoFH = Nothing: Application.ScreenUpdating = True
End Sub


 

Saludos.

P.D.: A ver si no lo eche a perder...:D

 

Share this post


Link to post
Share on other sites

Hola   Leopoldo Blancas ,  esta es la idea pero tengo que decirte que si hay cantidades en la fila F y en la Fila H al mismo tiempo funciona perfectamente, pero si solamente ha cantidades en la fila H no funciona, es decir cuando le doy al boton (COBRADO) se marca la línea en cuestión y me lanza un comentario que dice (Seleccione el destino y presione ENTRAR o elija Pegar) cuando lo suyo sería que los pasara a las hojas directamente.

Adjunto archivo  con tu modificación para puedas verlo.

Copiar filas a 2 hojas simultaneas_GP (2).xlsb

Share this post


Link to post
Share on other sites

Prueba así:

Sub CopiarFilasHojasGP()
Application.ScreenUpdating = False
Dim Filas As Long
With Hoja1
   For x = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      If .Range("F" & x) Or .Range("H" & x) Then
         .Rows(x).Copy Hoja2.Rows(Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1)
         .Rows(x).Copy Hoja3.Rows(Hoja3.Range("A" & Rows.Count).End(xlUp).Row + 1)
         .Rows(x).Delete
         x = x - 1
         Filas = Filas + 1
      End If
   Next
   MsgBox "Total filas copiadas: " & Filas, vbInformation, "AyudaExcel"
End With
End Sub

 

Share this post


Link to post
Share on other sites
Hace 1 hora, JSDJSD dijo:

Sub CopiarFilasHojas_GP()

Application.ScreenUpdating = False
Dim Filas As Long
Dim Filas1 As Long
With Hoja1
   For x = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      If .Range("F" & x) Then
         .Rows(x).Copy Hoja2.Rows(Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1)
         .Rows(x).Copy Hoja3.Rows(Hoja3.Range("A" & Rows.Count).End(xlUp).Row + 1)
         .Rows(x).Delete
         x = x - 1
         Filas = Filas + 1
      End If
   Next
   
   For x1 = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      If .Range("H" & x1) Then
         .Rows(x1).Copy Hoja2.Rows(Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1)
         .Rows(x1).Copy Hoja3.Rows(Hoja3.Range("A" & Rows.Count).End(xlUp).Row + 1)
          Range("H2:I1000").ClearContents ' como podria ponerlo para que no sea un rango fijo ?
         x1 = x1 - 1
         Filas1 = Filas1 + 1
      End If
   Next
   MsgBox "Total filas copiadas: " & Filas + Filas1, vbInformation, "AyudaExcel"
End With


End Sub

Con el código tal y como esta funciona perfecto, pero como podría simplificarlo y al mismo tiempo que el rango ("H2:I100").ClearContents no sea un rango fijo si no dinámico.

Share this post


Link to post
Share on other sites

A ver si es esto:

Sub CopiarFilasHojas_GP()
Application.ScreenUpdating = False
Dim Copiadas As Long, Eliminadas As Long
With Hoja1
   For x = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      If .Range("F" & x) Or .Range("H" & x) Then
         .Rows(x).Copy Hoja2.Rows(Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1)
         .Rows(x).Copy Hoja3.Rows(Hoja3.Range("A" & Rows.Count).End(xlUp).Row + 1)
         Copiadas = Copiadas + 1
         If .Range("F" & x) Then
            .Rows(x).Delete
            x = x - 1
            Eliminadas = Eliminadas + 1
         Else
            .Range("H" & x) = ""
         End If
      End If
   Next
   MsgBox "Total filas copiadas: " & Copiadas & Chr(10) & _
          "Total filas eliminadas: " & Eliminadas, vbInformation, "AyudaExcel"
End With
End Sub

 

Share this post


Link to post
Share on other sites

Ahora si que está perfecto, muchas gracias a ambos, ojalá llegara yo algún día por lo menos a la mitad del conocimientos que desmostrais a diario en este foro.

Tema Solucionado

Share this post


Link to post
Share on other sites

JSD!

Te adjunto el archivo siguiendo mi metodo, ademas otra versión sin usar ningun bucle!

La ventaja es que mientras no exista, celdas con comentarios, el ciclo sera igual, con el otro metodo el copiado lo hara "de golpe"

Y disculpa la tardanza, pero es que desde ayer ando celebrando la tri-champions:D y sigo!

 

Saludos

Copiar filas a 2 hojas simultaneas2_GP.xlsb

Share this post


Link to post
Share on other sites

Nunca es tarde cuando se comparten conocimientos con los demás y aún menos si es por un motivo como el que mencionas, tengo que decir que yo soy del Madrid hasta la médula pero también me gusta ver los partidos de nuestro eterno rival el Barcelona simplemente disfruto del buen fotbol tanto de unos como de otros.

Share this post


Link to post
Share on other sites
Hace 2 horas, JSDJSD dijo:

tengo que decir que yo soy del Madrid hasta la médula

Vaya sorpresa! o sea andas de "resaca":D [te pondré en mi lista de favoritos jaja]

Hace 2 horas, JSDJSD dijo:

pero también me gusta ver los partidos de nuestro eterno rival el Barcelona simplemente disfruto del buen fotbol tanto de unos como de otros.

Un comentario muy "maduro" :) pues hay muchos que no pueden ver al contrario [hasta se convierten:lol:]

 

Saludos

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png